ScSearchAndReplaceView.pas 57 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999
  1. {*******************************************************************************
  2. 单元名称: ScSearchAndReplaceView.pas
  3. 单元说明: 查找与替换。
  4. 作者时间: Chenshilong, 2010-5-18 22:32:50
  5. *******************************************************************************}
  6. unit ScSearchAndReplaceView;
  7. interface
  8. uses
  9. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  10. Dialogs, DB, ADODB, DBClient, ZjGridDBA, ExtCtrls, StdCtrls, ZJGrid,
  11. ScProject, ScBills, JimPages, ScUtils, ScRationAssistantDM, ScMessage, IniFiles,
  12. DBCtrls, Menus, Buttons, ScBillsDM, sdDB, sdGridDBA, ScConsts,
  13. sdGridTreeDBA, sdProvider;
  14. type
  15. TSearchKind = (skCode, skB_Code, skName);
  16. type
  17. TfrmSearchAndReplace = class(TFrame)
  18. pcSAndR: TJimPageControl;
  19. PageBill: TJimPage;
  20. zgBills: TZJGrid;
  21. PageRation: TJimPage;
  22. zgRations: TZJGrid;
  23. PageGLJ: TJimPage;
  24. Splitter1: TSplitter;
  25. zgGLJ: TZJGrid;
  26. zgRations2: TZJGrid;
  27. cdsBills: TClientDataSet;
  28. cdsBillsSerialNo: TIntegerField;
  29. cdsBillsID: TIntegerField;
  30. cdsBillsB_Code: TWideStringField;
  31. cdsBillsCode: TWideStringField;
  32. cdsBillsName: TWideStringField;
  33. zdBills: TZjGridDBA;
  34. zdRations: TZjGridDBA;
  35. cdsRations: TClientDataSet;
  36. cdsRationsID: TIntegerField;
  37. cdsRationsLibID: TIntegerField;
  38. cdsRationsCode: TWideStringField;
  39. cdsRationsBillsItemID: TIntegerField;
  40. cdsRationsMaskName: TWideStringField;
  41. cdsRationsName: TWideStringField;
  42. cdsRationsUnit: TWideStringField;
  43. cdsRationsQuantity: TFloatField;
  44. cdsRationsType: TSmallintField;
  45. cdsRationsSerialNo: TIntegerField;
  46. cdsRationsCodeForReport: TWideStringField;
  47. zdGLJ: TZjGridDBA;
  48. cdsGLJ: TClientDataSet;
  49. cdsGLJID: TIntegerField;
  50. cdsGLJLibID: TIntegerField;
  51. cdsGLJName: TWideStringField;
  52. cdsGLJSpecs: TWideStringField;
  53. cdsGLJUnit: TWideStringField;
  54. Panel1: TPanel;
  55. edtSearch: TEdit;
  56. btnSearch: TButton;
  57. rbBillB_Code: TRadioButton;
  58. rbBillName: TRadioButton;
  59. rbRationCode: TRadioButton;
  60. rbRationName: TRadioButton;
  61. rbGLJCode: TRadioButton;
  62. rbGLJName: TRadioButton;
  63. Bevel1: TBevel;
  64. pnReplace: TPanel;
  65. edtReplace: TEdit;
  66. btnReplace: TButton;
  67. lblReplace: TLabel;
  68. Label1: TLabel;
  69. cdsGLJBudgetPrice: TFloatField;
  70. cdsBillsQuantity: TFloatField;
  71. cdsBillsUnitPrice: TFloatField;
  72. cdsBillsTotalPrice: TFloatField;
  73. chkLocateFirstAppear: TCheckBox;
  74. chkAboveAverage: TCheckBox;
  75. edtAboveAverage: TEdit;
  76. lblAboveAverage: TLabel;
  77. Image2: TImage;
  78. rbBookmark: TRadioButton;
  79. PageBookmark: TJimPage;
  80. Splitter2: TSplitter;
  81. pmBM: TPopupMenu;
  82. mnClearAllBM: TMenuItem;
  83. mnClearCurBM: TMenuItem;
  84. cdsBillsIsME: TBooleanField;
  85. btnSearchAll: TButton;
  86. chkOnlyME: TCheckBox;
  87. cdsBillsUnits: TWideStringField;
  88. rbBillCode: TRadioButton;
  89. cdsBillsDesignQuantity: TCurrencyField;
  90. cdsBillsDesignPrice: TCurrencyField;
  91. Panel2: TPanel;
  92. zgBookmark: TZJGrid;
  93. zaColor: TZjGridDBA;
  94. pnlBM: TPanel;
  95. pnlColorSet: TPanel;
  96. zgColor: TZJGrid;
  97. Panel5: TPanel;
  98. pnlDefaultColor: TPanel;
  99. btnColorView: TSpeedButton;
  100. aqBookMarkColor: TADOQuery;
  101. aqBookMarkColorBMColor: TIntegerField;
  102. aqBookMarkColorBMMemo: TWideStringField;
  103. aqBookMarkColorCurColor: TIntegerField;
  104. aqSQL: TADOQuery;
  105. Panel3: TPanel;
  106. rbAll: TRadioButton;
  107. rbOnlyCur: TRadioButton;
  108. sdvBookMark: TsdDataView;
  109. sdvSearch: TsdDataView;
  110. sgdBookmark: TsdGridDBA;
  111. mmBM: TMemo;
  112. cdsGLJCode: TWideStringField;
  113. rbCountPrice: TRadioButton;
  114. rbDevices: TRadioButton;
  115. cdsRationsFTItemFlag: TBooleanField;
  116. cdsRationsIsMeCalc: TBooleanField;
  117. pnlSumBill: TPanel;
  118. cdsRationsBasePrice: TFloatField;
  119. PageCompareXML: TJimPage;
  120. zgCompareXML: TZJGrid;
  121. zaCompareXML: TZjGridDBA;
  122. cdsCompareXML: TClientDataSet;
  123. cdsCompareXMLBillID: TIntegerField;
  124. cdsCompareXMLRationID: TIntegerField;
  125. cdsCompareXMLDrawQtyID: TIntegerField;
  126. cdsCompareXMLOperate: TStringField;
  127. cdsCompareXMLKind: TStringField;
  128. cdsCompareXMLCode: TStringField;
  129. cdsCompareXMLB_Code: TStringField;
  130. cdsCompareXMLName: TStringField;
  131. cdsCompareXMLQuantity: TStringField;
  132. cdsCompareXMLDgnQuantity1: TStringField;
  133. cdsCompareXMLDgnQuantity2: TStringField;
  134. rbCompareXML: TRadioButton;
  135. pnlSelectXMLFile: TPanel;
  136. btnSelectFile: TSpeedButton;
  137. edtFile: TEdit;
  138. smpRations2: TsdMemoryProvider;
  139. stdRations2: TsdGridTreeDBA;
  140. sdsRations2: TsdDataSet;
  141. sdvRations2: TsdDataView;
  142. pnlSumRation: TPanel;
  143. cdsRationsUnitFee: TWideStringField;
  144. cdsRationsTotalFee: TFloatField;
  145. cdsRationsAdjustState: TWideStringField;
  146. cdsRationsUnitPrice: TFloatField;
  147. procedure cdsRationsTypeGetText(Sender: TField; var Text: String;
  148. DisplayText: Boolean);
  149. procedure zgRationsMouseDown(Sender: TObject; Button: TMouseButton;
  150. Shift: TShiftState; X, Y: Integer);
  151. procedure zgBillsMouseDown(Sender: TObject; Button: TMouseButton;
  152. Shift: TShiftState; X, Y: Integer);
  153. procedure btnReplaceClick(Sender: TObject);
  154. procedure zgRationsShowHint(var HintStr: String; var CanShow: Boolean;
  155. var HintInfo: THintInfo; const ACoord: TPoint);
  156. procedure zgRations2ShowHint(var HintStr: String; var CanShow: Boolean;
  157. var HintInfo: THintInfo; const ACoord: TPoint);
  158. procedure DoOnBillsScroll(DataSet: TDataSet);
  159. procedure btnSearchRationClick(Sender: TObject);
  160. procedure edtSearchKeyDown(Sender: TObject; var Key: Word;
  161. Shift: TShiftState);
  162. procedure btnSearchClick(Sender: TObject);
  163. procedure zgBillsShowHint(var HintStr: String; var CanShow: Boolean;
  164. var HintInfo: THintInfo; const ACoord: TPoint);
  165. procedure cdsGLJAfterScroll(DataSet: TDataSet);
  166. procedure rbBillB_CodeClick(Sender: TObject);
  167. procedure rbBillNameClick(Sender: TObject);
  168. procedure rbRationCodeClick(Sender: TObject);
  169. procedure rbRationNameClick(Sender: TObject);
  170. procedure rbGLJCodeClick(Sender: TObject);
  171. procedure rbGLJNameClick(Sender: TObject);
  172. procedure edtAboveAverageKeyPress(Sender: TObject; var Key: Char);
  173. procedure zgBillsCellGetColor(Sender: TObject; ACoord: TPoint;
  174. var AColor: TColor);
  175. procedure edtAboveAverageExit(Sender: TObject);
  176. procedure rbBookmarkClick(Sender: TObject);
  177. procedure zgBookmarkMouseDown(Sender: TObject; Button: TMouseButton;
  178. Shift: TShiftState; X, Y: Integer);
  179. procedure mmBMExit(Sender: TObject);
  180. procedure mnClearAllBMClick(Sender: TObject);
  181. procedure mnClearCurBMClick(Sender: TObject);
  182. procedure btnSearchAllClick(Sender: TObject);
  183. procedure chkOnlyMEClick(Sender: TObject);
  184. procedure chkAboveAverageClick(Sender: TObject);
  185. procedure cdsBillsDesignQuantityGetText(Sender: TField;
  186. var Text: String; DisplayText: Boolean);
  187. procedure mmBMEnter(Sender: TObject);
  188. procedure zgColorCellGetColor(Sender: TObject; ACoord: TPoint;
  189. var AColor: TColor);
  190. procedure btnColorViewClick(Sender: TObject);
  191. procedure zgBookmarkCellGetColor(Sender: TObject; ACoord: TPoint;
  192. var AColor: TColor);
  193. procedure zgColorMouseDown(Sender: TObject; Button: TMouseButton;
  194. Shift: TShiftState; X, Y: Integer);
  195. procedure zgColorShowHint(var HintStr: String; var CanShow: Boolean;
  196. var HintInfo: THintInfo; const ACoord: TPoint);
  197. procedure rbAllClick(Sender: TObject);
  198. procedure rbOnlyCurClick(Sender: TObject);
  199. procedure aqBookMarkColorAfterScroll(DataSet: TDataSet);
  200. procedure sdvBookMarkFilterRecord(ARecord: TsdDataRecord;
  201. var Allow: Boolean);
  202. procedure sdvBookMarkCurrentChanged(ARecord: TsdDataRecord);
  203. procedure mmBMChange(Sender: TObject);
  204. procedure zgCompareXMLMouseDown(Sender: TObject; Button: TMouseButton;
  205. Shift: TShiftState; X, Y: Integer);
  206. procedure zgCompareXMLCellGetFont(Sender: TObject; ACoord: TPoint;
  207. AFont: TFont);
  208. procedure rbCompareXMLClick(Sender: TObject);
  209. procedure zgRations2CellGetColor(Sender: TObject; ACoord: TPoint;
  210. var AColor: TColor);
  211. private
  212. { Private declarations }
  213. FBillsTree: TScBillsTree;
  214. FProject: TScProject;
  215. FRADM: TRationAssistantDM;
  216. FAggUnitPrice: TAggregate;
  217. procedure LocateCurBills;
  218. procedure SetProject(const Value: TScProject);
  219. procedure RadioButtonCheck;
  220. procedure ReplaceEnable(AEnable: Boolean);
  221. procedure AboveAverageEnable(AEnable: Boolean);
  222. procedure FilterME(AOnlyME: Boolean);
  223. procedure DeleteBookMark(ARec: TScBillsRecord);
  224. procedure SetDefaultColor;
  225. procedure FilterColor;
  226. procedure RefreshBookmarkStr(ARecord: TsdDataRecord);
  227. public
  228. { Public declarations }
  229. procedure Init(AProject: TScProject; AShowBookmark: Boolean = False);
  230. property RADM: TRationAssistantDM read FRADM;
  231. property Project: TScProject read FProject write SetProject;
  232. constructor Create(AOwner: TComponent); override;
  233. destructor Destroy; override;
  234. procedure SearchRations(AValue: String; ASearchKind: TSearchKind);
  235. procedure SearchBills(AValue: String; ASearchKind: TSearchKind;
  236. OnlyFirstParts: Boolean = False);
  237. procedure SearchGLJs(AValue: String; ASearchKind: TSearchKind);
  238. procedure SearchBillsByB_Code(AValue: String);
  239. procedure SearchRationsByGLJ(AGLJID: Integer);
  240. procedure SearchRecords(SearchText: string);
  241. procedure SearchBookmarks;
  242. procedure CompareFromXML;
  243. procedure Search(SearchText: string; AType: TSearchType);
  244. property AggUnitPrice: TAggregate read FAggUnitPrice write FAggUnitPrice;
  245. end;
  246. implementation
  247. uses
  248. ZjCells, ScRations, ScProjectGLJ, ScGLJ, ScProjFrm, Math, ScConfig,
  249. ScProjBaseDM, sdIDTree, ScXMLPort, ScMainFrm,
  250. ScBillsSubItemViews;
  251. Const sDefStr = '请在此位置输入批注';
  252. {$R *.dfm}
  253. procedure TfrmSearchAndReplace.Init(AProject: TScProject; AShowBookmark: Boolean);
  254. var ini: TIniFile;
  255. begin
  256. FBillsTree := AProject.Bills.BillsTree;
  257. sdsRations2.Open;
  258. sdvRations2.Open;
  259. sdsRations2.DeleteAll;
  260. // Aggregate
  261. cdsBills.AggregatesActive := True;
  262. AggUnitPrice := cdsBills.Aggregates.Add;
  263. if Project.IsGuangDong then
  264. begin
  265. AggUnitPrice.IndexName := 'IdxBCodeCode';
  266. // chkOnlyME.Visible := True;
  267. end
  268. else
  269. begin
  270. // AggUnitPrice.IndexName := 'IdxName'; 这个索引导致计算的平均值为0,换成Code
  271. AggUnitPrice.IndexName := 'IdxCode';
  272. // chkOnlyME.Visible := False;
  273. end;
  274. AggUnitPrice.GroupingLevel := 1;
  275. if Project.IsBudget then
  276. AggUnitPrice.Expression := 'Avg(DesignPrice)' // 概预算计算的平均值是0,暂未找到原因
  277. else
  278. AggUnitPrice.Expression := 'Avg(UnitPrice)';
  279. AggUnitPrice.Active := True;
  280. ini:= TIniFile.Create(ConfigInfo.SystemIniFileName);
  281. try
  282. edtAboveAverage.Text:=ini.ReadString('Options','AboveAveragePercent','10');
  283. finally
  284. ini.Free;
  285. end;
  286. pcSAndR.ShowTabs := False;
  287. pcSAndR.ActivePage := PageBill;
  288. // zgRations.CellClass.Cols[3] := TZjCheckBoxCell;
  289. cdsBills.IndexDefs.Clear;
  290. cdsBills.IndexDefs.Add('IdxBCodeCode', 'B_Code;Code', []);
  291. cdsBills.IndexDefs.Add('IdxCode', 'Code', []);
  292. cdsBills.IndexDefs.Add('IdxNameBCode', 'Name;B_Code', []);
  293. cdsBills.IndexDefs.Add('IdxName', 'Name', []);
  294. // 估概算项目、预算项目只有Code,没有B_Code。有设计数量和经济指标,没有数量单价
  295. if Project.IsBudget then
  296. begin
  297. zdBills.Columns[0].Width := 58;
  298. zdBills.Columns[1].Width := 0;
  299. zdBills.Columns[4].Width := 0;
  300. zdBills.Columns[5].Width := 0;
  301. zdBills.Columns[6].Width := 50;
  302. zdBills.Columns[7].Width := 50;
  303. zdBills.Columns[0].Title.Caption := '预算项目节';
  304. zdBills.Columns[2].title.caption:= '分项名称';
  305. cdsBills.IndexName := 'IdxCode';
  306. rbBillCode.Caption := '预算项目节';
  307. rbBillCode.Visible := True;
  308. rbBillB_Code.Visible := False;
  309. if AShowBookmark then
  310. rbBookmark.Checked := True
  311. else
  312. rbBillCode.Checked := True;
  313. end
  314. else if Project.IsGD3J then
  315. begin
  316. zdBills.Columns[0].Width := 0;
  317. zdBills.Columns[1].Width := 58;
  318. zdBills.Columns[4].Width := 50;
  319. zdBills.Columns[5].Width := 50;
  320. zdBills.Columns[6].Width := 0;
  321. zdBills.Columns[7].Width := 0;
  322. zdBills.Columns[0].Title.Caption := '预算项目节';
  323. zdBills.Columns[2].Title.Caption := '清单名称';
  324. cdsBills.IndexName := 'IdxBCodeCode';
  325. rbBillB_Code.Visible := True;
  326. rbBillCode.Visible := False;
  327. if AShowBookmark then
  328. rbBookmark.Checked := True
  329. else
  330. rbBillB_Code.Checked := True;
  331. // 广东版要点击清单反向定位到按清单子目号查找定位的窗口中。
  332. // 新控件这个地方不好实现,先不管。chenshilongWaiting
  333. // FProject.Bills.BillsDM.OnBillsAfterScrollForSearch := DoOnBillsScroll;
  334. // chkLocateFirstAppear.Visible := True;
  335. end
  336. else
  337. begin
  338. rbBillB_Code.Visible := False;
  339. rbBillCode.Visible := True;
  340. if AShowBookmark then
  341. rbBookmark.Checked := True
  342. else
  343. rbGLJCode.Checked := True;
  344. cdsBills.IndexName := 'IdxName';
  345. zdBills.Columns[0].Width := 58;
  346. zdBills.Columns[1].Width := 0;
  347. zdBills.Columns[4].Width := 50;
  348. zdBills.Columns[5].Width := 50;
  349. zdBills.Columns[6].Width := 0;
  350. zdBills.Columns[7].Width := 0;
  351. zdBills.Columns[0].Title.Caption := '清单编号'
  352. end;
  353. zgBills.CurCol := 3;
  354. cdsRations.EmptyDataSet;
  355. cdsRations.IndexFieldNames := 'Code;BillsItemID;SerialNo';
  356. cdsBills.EmptyDataSet;
  357. // cdsSearch.IndexDefs.Add('idxB_Code', 'B_Code', []);
  358. // to do(s): cdsSearch.CloneCursor(AProject.Bills.cdsOrgBills, True);
  359. // cdsSearch.IndexName := 'idxB_Code';
  360. sdvSearch.DataSet := AProject.Bills.BillsDM.sdsBills;
  361. sdvSearch.IndexName := 'idxB_Code';
  362. cdsGLJ.IndexDefs.Clear;
  363. cdsGLJ.AddIndex('idxCode', 'Code', []);
  364. cdsGLJ.IndexName := 'idxCode';
  365. sdvBookMark.DataSet := AProject.Bills.BillsDM.sdsBills;
  366. sdvBookMark.Active := True;
  367. SearchRecords(Trim(edtSearch.Text));
  368. zgBookmark.Height := zgBookmark.Parent.Height - Splitter2.Height - 250;
  369. if AProject.ProjType in [ptBudget, ptBudgetEstimate, ptProposalEstimate,
  370. ptFeasibilityEstimate] then
  371. begin
  372. rbBillCode.Caption := '分项编号';
  373. rbBillName.Caption := '分项名称';
  374. end
  375. else
  376. begin
  377. rbBillCode.Caption := '清单编号';
  378. rbBillName.Caption := '清单名称';
  379. end;
  380. if AProject.IsGD3J then
  381. begin
  382. sgdBookmark.Columns[1].Visible := True;
  383. sgdBookmark.Columns[1].Title.Caption := '清单子目号';
  384. end
  385. else
  386. begin
  387. //sgdBookmark.Columns[1].Title.Caption := '分项编号';
  388. sgdBookmark.Columns[1].Visible := False;
  389. end;
  390. aqBookMarkColor.Connection := AProject.DM.acnProject;
  391. aqBookMarkColor.Open;
  392. pnlDefaultColor.Color := AProject.BookMarkColor;
  393. // lblDefaultColor.Color := AProject.BookMarkColor;
  394. aqSQL.Connection := AProject.DM.acnProject;
  395. end;
  396. procedure TfrmSearchAndReplace.cdsRationsTypeGetText(
  397. Sender: TField; var Text: String; DisplayText: Boolean);
  398. begin
  399. if DisplayText then
  400. begin
  401. if Sender.AsInteger = 0 then
  402. Text := 'False'
  403. else if Sender.AsInteger = 1 then
  404. Text := 'True';
  405. end;
  406. end;
  407. procedure TfrmSearchAndReplace.LocateCurBills;
  408. var
  409. ProjForm: TScProjForm;
  410. vNode, RNode: TsdIDTreeNode;
  411. begin
  412. ProjForm := TScProjForm(Application.MainForm.ActiveMDIChild);
  413. // 清单
  414. if pcSAndR.ActivePageIndex = 0 then
  415. begin
  416. if cdsBills.Active and (cdsBills.RecordCount > 0) then
  417. begin
  418. vNode := FBillsTree[cdsBillsID.Value];
  419. if vNode <> nil then
  420. begin
  421. if not vNode.Expanded then
  422. vNode.Expanded := True;
  423. vNode.LocateInControl;
  424. end
  425. else
  426. begin
  427. if FProject.IsBills then
  428. MessageHint(0, '无法定位,清单可能已被删除。')
  429. else
  430. MessageHint(0, '无法定位,分项可能已被删除。');
  431. end;
  432. end;
  433. end
  434. // 定额
  435. else if pcSAndR.ActivePageIndex = 1 then
  436. begin
  437. // 定位清单
  438. if cdsRations.Active and (cdsRations.RecordCount > 0) then
  439. begin
  440. vNode := FBillsTree.FindNode(cdsRationsBillsItemID.Value);
  441. if vNode <> nil then
  442. begin
  443. if not vNode.Expanded then
  444. vNode.Expanded := True;
  445. vNode.LocateInControl;
  446. end
  447. else
  448. begin
  449. if FProject.IsBills then
  450. MessageHint(0, '无法定位,该定额所在的清单可能已被删除。')
  451. else
  452. MessageHint(0, '无法定位,该定额所在的分项可能已被删除。');
  453. Exit;
  454. end;
  455. end;
  456. // 定位定额
  457. if cdsRationsType.AsInteger = 0 then
  458. begin
  459. ProjForm.tbtnAll.Click;
  460. ProjForm.tbtnAll.Down := True;
  461. FProject.Rations.LocateRation(cdsRationsID.AsInteger);
  462. end
  463. // 定位数量单价
  464. else if cdsRationsType.AsInteger = 1 then
  465. begin
  466. // ProjForm.BillsSubItemView.PageControl.ActivePageIndex := 1;
  467. if not cdsRationsIsMeCalc.AsBoolean then
  468. begin
  469. ProjForm.tbtnAll.Click;
  470. ProjForm.tbtnAll.Down := True;
  471. FProject.Rations.LocateRation(cdsRationsID.AsInteger);
  472. (* if ConfigInfo.RationDisplayMode = 0 then
  473. begin
  474. ProjForm.btnRation.Click;
  475. ProjForm.btnRation.Down := True;
  476. FProject.Rations.LocateRation(cdsRationsID.AsInteger);
  477. end
  478. else
  479. begin
  480. ProjForm.btnCountPrice.Click;
  481. ProjForm.btnCountPrice.Down := True;
  482. FProject.Rations.LocateCountPrice(cdsRationsID.AsInteger);
  483. end; *)
  484. end
  485. else
  486. begin
  487. ProjForm.btnME.Click;
  488. ProjForm.btnME.Down := True;
  489. FProject.Rations.LocateDevices(cdsRationsID.AsInteger);
  490. end
  491. end;
  492. end
  493. // 工料机
  494. else if pcSAndR.ActivePageIndex = 2 then
  495. begin
  496. if sdvRations2.Active and (sdvRations2.RecordCount > 0) then
  497. begin
  498. RNode := stdRations2.IDTree.Selected;
  499. if RNode <> nil then
  500. begin
  501. // 定额通过SBillsItemID定位,清单直接通过ID定位
  502. if RNode.Rec.ValueByName('IsRation').AsBoolean then
  503. vNode := FBillsTree.FindNode(RNode.Rec.ValueByName(SBillsItemID).AsInteger)
  504. else
  505. vNode := FBillsTree.FindNode(RNode.ID);
  506. if vNode <> nil then
  507. begin
  508. if not vNode.Expanded then
  509. vNode.Expanded := True;
  510. vNode.LocateInControl;
  511. end
  512. else
  513. begin
  514. if FProject.IsBills then
  515. MessageHint(0, '无法定位,该工料机所在的清单可能已被删除。')
  516. else
  517. MessageHint(0, '无法定位,该工料机所在的分项可能已被删除。');
  518. Exit;
  519. end;
  520. // 是定额则定位定额
  521. if RNode.Rec.ValueByName('IsRation').AsBoolean then
  522. begin
  523. ProjForm.BillsSubItemView.PageControl.ActivePageIndex := 0;
  524. ProjForm.btnRation.Down := True;
  525. FProject.Rations.LocateRation(RNode.Rec.ValueByName(SRationID).AsInteger);
  526. end;
  527. end;
  528. end;
  529. end
  530. // 书签
  531. else if pcSAndR.ActivePageIndex = 3 then
  532. begin
  533. // 定位清单
  534. if sdvBookMark.Active and (sdvBookMark.RecordCount > 0) then
  535. begin
  536. vNode := FBillsTree.FindNode(TScBillsRecord(sdvBookMark.Current).ID.AsInteger);
  537. if vNode <> nil then
  538. begin
  539. if not vNode.Expanded then
  540. vNode.Expanded := True;
  541. vNode.LocateInControl;
  542. end
  543. else
  544. begin
  545. if FProject.IsBills then
  546. MessageHint(0, '无法定位,该书签对应的清单可能已被删除。')
  547. else
  548. MessageHint(0, '无法定位,该书签对应的分项可能已被删除。');
  549. Exit;
  550. end;
  551. end;
  552. end;
  553. end;
  554. procedure TfrmSearchAndReplace.zgRationsMouseDown(Sender: TObject;
  555. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  556. begin
  557. if ssDouble in Shift then
  558. LocateCurBills;
  559. end;
  560. procedure TfrmSearchAndReplace.SearchRations(AValue: String; ASearchKind: TSearchKind);
  561. var
  562. I: Integer;
  563. sdRation: TScRationRecord;
  564. sFiledValue: String;
  565. vGLJ: TScGLJRecord;
  566. fSumT, fSumQ: Double;
  567. begin
  568. try
  569. Screen.Cursor := crHourGlass;
  570. cdsRations.DisableControls;
  571. fSumT := 0;
  572. fSumQ := 0;
  573. for I := 0 to FProject.Rations.sdsRations.RecordCount - 1 do
  574. begin
  575. sdRation := TScRationRecord(FProject.Rations.sdsRations[I]);
  576. // 分摊的定额过滤掉
  577. if sdRation.FTItemFlag.AsInteger = 1 then Continue;
  578. if (rbRationCode.Checked or rbRationName.Checked) and (sdRation.RationType.AsInteger <> 0) then
  579. Continue;
  580. if rbCountPrice.Checked and ((sdRation.RationType.AsInteger <> 1) or sdRation.IsMECalc.AsBoolean) then
  581. Continue;
  582. if rbDevices.Checked and ((sdRation.RationType.AsInteger <> 1) or (not sdRation.IsMECalc.AsBoolean)) then
  583. Continue;
  584. case ASearchKind of
  585. skCode: sFiledValue := sdRation.Code.AsString;
  586. skName: sFiledValue := sdRation.Name.AsString;
  587. end;
  588. if ((AValue = '') or (Pos(AValue, sFiledValue) > 0)) and (sdRation.Quantity.AsFloat <> 0) then
  589. begin
  590. cdsRations.Append;
  591. cdsRationsID.AsInteger := sdRation.ID.AsInteger;
  592. cdsRationsLibID.AsInteger := sdRation.LibID.AsInteger;
  593. cdsRationsCode.AsString := sdRation.Code.AsString;
  594. cdsRationsBillsItemID.AsInteger := sdRation.BillsItemID.AsInteger;
  595. cdsRationsName.AsString := sdRation.Name.AsString;
  596. cdsRationsMaskName.AsString := sdRation.MaskName.AsString;
  597. cdsRationsUnit.AsString := ConvertUnitStr(sdRation.Units.AsString);
  598. cdsRationsQuantity.AsFloat := sdRation.Quantity.AsFloat;
  599. if rbCountPrice.Checked or rbDevices.Checked then
  600. cdsRationsUnitPrice.AsFloat := sdRation.UnitDirectFee.AsFloat
  601. else
  602. cdsRationsUnitPrice.AsFloat := sdRation.BuildingUnitPrice.AsFloat;
  603. cdsRationsType.AsInteger := sdRation.RationType.AsInteger;
  604. cdsRationsCodeForReport.AsString := sdRation.CodeForReport.AsString;
  605. cdsRationsSerialNo.AsInteger := sdRation.SerialNo.AsInteger;
  606. cdsRationsIsMeCalc.AsBoolean := sdRation.IsMECalc.AsBoolean;
  607. cdsRationsUnitFee.AsFloat := sdRation.UnitDirectFee.AsFloat;
  608. cdsRationsTotalFee.AsFloat := sdRation.BuildingFee.AsFloat;
  609. cdsRationsAdjustState.AsString := sdRation.AdjustState.AsString;
  610. if (sdRation.RationType.AsInteger = 0) then // 定额
  611. begin
  612. vGLJ := FProject.GLJ.FindGLJByRationIDAndGLJCode(sdRation.ID.AsInteger, SJiJiaCode);
  613. if vGLJ <> nil then
  614. cdsRationsBasePrice.AsFloat := vGLJ.Quantity.AsFloat;
  615. end
  616. else
  617. begin
  618. if sdRation.IsMECalc.AsBoolean then
  619. cdsRationsBasePrice.AsFloat := sdRation.UnitDirectFee.AsFloat;
  620. end;
  621. fSumT := fSumT + sdRation.BuildingFee.AsFloat;
  622. fSumQ := fSumQ + sdRation.Quantity.AsFloat;
  623. end;
  624. end;
  625. cdsRations.First;
  626. // if (rbCountPrice.Checked or rbDevices.Checked) then
  627. // begin
  628. // pnlSumRation.Visible := True;
  629. // pnlSumRation.Caption := Format('【金额合计】%g', [fSumT]);
  630. // end
  631. // else
  632. // begin
  633. // pnlSumRation.Visible := False;
  634. // end;
  635. pnlSumRation.Caption := Format('【金额合计】%g 【数量合计】%g', [fSumT, fSumQ]);
  636. finally
  637. cdsRations.EnableControls;
  638. Screen.Cursor := crDefault;
  639. end;
  640. end;
  641. procedure TfrmSearchAndReplace.SearchBills(AValue: String; ASearchKind:
  642. TSearchKind; OnlyFirstParts: Boolean);
  643. var
  644. ACDS, cdsFind: TClientDataSet;
  645. sFiledValue: String;
  646. vTree: TScBillsTree;
  647. Item2Idx, Item3Idx, TreeMaxIdx, i, curIdx: Integer;
  648. bIsME: Boolean;
  649. fSumT, fSumQ: Double;
  650. begin
  651. try
  652. Screen.Cursor := crHourGlass;
  653. cdsBills.DisableControls;
  654. vTree := FProject.Bills.BillsTree;
  655. Item2Idx := vTree[2].MajorIndex;
  656. Item3Idx := vTree[3].MajorIndex;
  657. if not Assigned(vTree[6]) then
  658. TreeMaxIdx := vTree[10].MajorIndex
  659. else
  660. TreeMaxIdx := vTree[6].MajorIndex;
  661. fSumT := 0;
  662. fSumQ := 0;
  663. for i := 0 to TreeMaxIdx do
  664. begin
  665. case ASearchKind of
  666. skCode: sFiledValue := vTree.Items[i].Code;
  667. {$IFDEF _ScGuangDong}
  668. skB_Code: sFiledValue := vTree.Items[i].B_Code;
  669. {$ENDIF}
  670. skName: sFiledValue := vTree.Items[i].Name;
  671. end;
  672. if (AValue = '') or (Pos(AValue, sFiledValue) > 0) then
  673. begin
  674. if FProject.IsGuangDong then
  675. if (ASearchKind = skB_Code) then
  676. begin
  677. if vTree.Items[i].B_Code = '' then
  678. Continue;
  679. end;
  680. // 只显示机电:用Filter后重新指定索引会提示“operation not permitted”
  681. // 所以不用Filter,直接在这里处理
  682. curIdx := vTree.Items[i].MajorIndex;
  683. bIsME := (curIdx > Item2Idx) and (curIdx < Item3Idx);
  684. if (not bIsME) and chkOnlyME.Checked then
  685. Continue;
  686. cdsBills.Append;
  687. cdsBillsIsME.AsBoolean := bIsME;
  688. cdsBillsSerialNo.AsInteger := curIdx;
  689. cdsBillsID.AsInteger:= vTree.Items[i].ID;
  690. cdsBillsCode.AsString := vTree.Items[i].Code;
  691. if FProject.IsGuangDong then
  692. cdsBillsB_Code.AsString := vTree.Items[i].Rec.B_Code.AsString;
  693. cdsBillsName.AsString := vTree.Items[i].Rec.Name.AsString;
  694. cdsBillsUnits.AsString := vTree.Items[i].Rec.Units.AsString;
  695. cdsBillsQuantity.AsFloat := vTree.Items[i].Rec.Quantity.AsFloat;
  696. cdsBillsUnitPrice.AsFloat := vTree.Items[i].Rec.UnitPrice.AsFloat;
  697. cdsBillsDesignQuantity.AsFloat := vTree.Items[i].Rec.DesignQuantity.AsFloat;
  698. cdsBillsDesignPrice.AsFloat := vTree.Items[i].Rec.DesignPrice.AsFloat;
  699. cdsBillsTotalPrice.AsFloat := vTree.Items[i].Rec.TotalPrice.AsFloat;
  700. cdsBills.Post;
  701. fSumT := fSumT + vTree.Items[i].Rec.TotalPrice.AsFloat;
  702. fSumQ := fSumQ + vTree.Items[i].Rec.Quantity.AsFloat;
  703. end;
  704. end;
  705. finally
  706. cdsBills.EnableControls;
  707. pnlSumBill.Caption := Format('【金额合计】%g 【数量合计】%g', [fSumT, fSumQ]);
  708. Screen.Cursor := crDefault;
  709. end;
  710. end;
  711. procedure TfrmSearchAndReplace.zgBillsMouseDown(Sender: TObject;
  712. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  713. begin
  714. if ssDouble in Shift then
  715. LocateCurBills;
  716. end;
  717. procedure TfrmSearchAndReplace.btnReplaceClick(Sender: TObject);
  718. var s1,s2, newName: string;
  719. sdRation: TScRationRecord;
  720. begin
  721. if not (rbBillName.Checked or rbRationName.Checked) then Exit;
  722. s1 := trim(edtSearch.Text);
  723. s2 := trim(edtReplace.Text);
  724. if (s1 = '') or (s2 = '') then exit;
  725. if ((not cdsBills.Active) or (cdsBills.RecordCount < 1)) and
  726. ((not cdsRations.Active) or (cdsRations.RecordCount < 1)) then exit;
  727. if not MessageQuest('确定要将查询结果中所有包含的 “'+ s1 + '” 替换成 “' + s2 + '” 吗?') then Exit;
  728. Screen.Cursor := crHourGlass;
  729. try
  730. if rbBillName.Checked then
  731. begin
  732. FProject.Bills.BillsDM.sdsBills.BeginUpdate;
  733. try
  734. cdsBills.First;
  735. while not cdsBills.Eof do
  736. begin
  737. newName := StringReplace(cdsBillsName.AsString, s1, s2, [rfReplaceAll,rfIgnoreCase]);
  738. FProject.Bills.BillsTree[cdsBillsID.AsInteger].Rec.Name.AsString := newName;
  739. cdsBills.Next;
  740. end;
  741. finally
  742. FProject.Bills.BillsDM.sdsBills.EndUpdate;
  743. end;
  744. cdsBills.EmptyDataSet;
  745. SearchBills(s2, skName, True);
  746. end
  747. else if rbRationName.Checked then
  748. begin
  749. cdsRations.First;
  750. while not cdsRations.Eof do
  751. begin
  752. newName := StringReplace(cdsRationsName.AsString, s1, s2, [rfReplaceAll,rfIgnoreCase]);
  753. sdRation := FProject.Rations.FindRation(cdsRationsID.AsInteger);
  754. sdRation.Name.AsString := newName;
  755. cdsRations.Next;
  756. end;
  757. cdsRations.EmptyDataSet;
  758. SearchRations(s2, skName);
  759. end;
  760. finally
  761. Screen.Cursor := crDefault;
  762. end;
  763. end;
  764. procedure QuickSortChildren(AParent: TsdIDTreeNode);
  765. function CompareNode(ANode1, ANode2: TsdIDTreeNode): Integer;
  766. var
  767. iSN1, iSN2: Integer;
  768. begin
  769. iSN1 := ANode1.Rec.ValueByName(SSerialNo).AsInteger;
  770. iSN2 := ANode2.Rec.ValueByName(SSerialNo).AsInteger;
  771. if iSN1 > iSN2 then
  772. Result := 1
  773. else if iSN1 < iSN2 then
  774. Result := -1
  775. else
  776. Result := 0;
  777. end;
  778. procedure QuickSort(iLo, iHi: Integer);
  779. var
  780. Lo, Hi: Integer;
  781. Mid: TsdIDTreeNode;
  782. begin
  783. Lo := iLo;
  784. Hi := iHi;
  785. Mid := AParent.ChildNodes[(iLo + iHi) div 2];
  786. repeat
  787. while CompareNode(AParent.ChildNodes[Lo], Mid) < 0 do Lo := Lo + 1;
  788. while CompareNode(AParent.ChildNodes[Hi], Mid) > 0 do Hi := Hi - 1;
  789. if Lo <= Hi then
  790. begin
  791. if Lo < Hi then begin
  792. AParent.Owner.Exchange(AParent.ChildNodes[Lo], AParent.ChildNodes[Hi]);
  793. end;
  794. Lo := Lo + 1;
  795. Hi := Hi - 1;
  796. end;
  797. until Lo > Hi;
  798. if Hi > iLo then QuickSort(iLo, Hi);
  799. if Lo < iHi then QuickSort(Lo, iHi);
  800. end;
  801. begin
  802. if AParent.ChildCount > 1 then QuickSort(0, AParent.ChildCount - 1);
  803. end;
  804. procedure TfrmSearchAndReplace.SearchRationsByGLJ(AGLJID: Integer);
  805. var
  806. Tree: TsdIDTree;
  807. lstBillsID: TList;
  808. function AddNode(ABillsItem: TScBillsItem): TsdIDTreeNode;
  809. var
  810. Node, ParentNode: TsdIDTreeNode;
  811. BillsNode, ParentBills, NextBills: TScBillsItem;
  812. I, iParentID, iNextID: Integer;
  813. strCode: string;
  814. begin
  815. Result := nil;
  816. // 先找节点是否存在
  817. Node := Tree.FindNode(ABillsItem.ID);
  818. if Node <> nil then
  819. begin
  820. Result := Node;
  821. Exit;
  822. end;
  823. // 递归
  824. if (ABillsItem <> nil) and (ABillsItem.Parent <> nil) then
  825. ParentNode := AddNode(TScBillsItem(ABillsItem.Parent));
  826. // 确定后兄弟
  827. ParentBills := TScBillsItem(ABillsItem.Parent);
  828. NextBills := nil;
  829. BillsNode := TScBillsItem(ABillsItem.NextSibling);
  830. while BillsNode <> nil do
  831. begin
  832. if ((not BillsNode.IsLeaf) or (lstBillsID.IndexOf(Pointer(BillsNode.ID)) >= 0)) and (Tree.FindNode(BillsNode.ID) <> nil) then
  833. begin
  834. NextBills := BillsNode;
  835. Break;
  836. end;
  837. BillsNode := TScBillsItem(BillsNode.NextSibling);
  838. end;
  839. // 添加
  840. if ParentBills <> nil then
  841. iParentID := ParentBills.ID
  842. else
  843. iParentID := -1;
  844. if NextBills <> nil then
  845. iNextID := NextBills.ID
  846. else
  847. iNextID := -1;
  848. Result := Tree.Add(ABillsItem.ID, iParentID, iNextID, True);
  849. try
  850. if ABillsItem.Rec.B_Code.AsString <> '' then
  851. strCode := ABillsItem.Rec.B_Code.AsString
  852. else
  853. strCode := ABillsItem.Rec.Code.AsString;
  854. Result.Rec.ValueByName(SCode).AsString := strCode;
  855. Result.Rec.ValueByName(SName).AsString := ABillsItem.Rec.Name.AsString;
  856. Result.Rec.ValueByName(SUnitPrice).AsCurrency := ABillsItem.Rec.UnitPrice.AsCurrency;
  857. Result.Rec.ValueByName('IsRation').AsBoolean := False;
  858. finally
  859. Result.Rec.EndUpdate;
  860. end;
  861. end;
  862. function AddParents(ABillsItemID: Integer): TsdIDTreeNode;
  863. var
  864. BillsItem: TScBillsItem;
  865. begin
  866. Result := Tree.FindNode(ABillsItemID);
  867. if Result <> nil then Exit;
  868. BillsItem := FBillsTree.BillsItem[ABillsItemID];
  869. Result := AddNode(BillsItem);
  870. end;
  871. procedure ResortRations(ANode: TsdIDTreeNode);
  872. begin
  873. if ANode = nil then Exit;
  874. if ANode.ChildCount > 0 then
  875. begin
  876. if ANode.FirstChild.Rec.ValueByName('IsRation').AsBoolean then
  877. QuickSortChildren(ANode)
  878. else
  879. ResortRations(ANode.FirstChild);
  880. end;
  881. ResortRations(ANode.NextSibling);
  882. end;
  883. var
  884. I, iLength: Integer;
  885. Node, ParentNode: TsdIDTreeNode;
  886. Rec: TsdDataRecord;
  887. sdRation: TScRationRecord;
  888. BillsRec: TScBillsRecord;
  889. RationIDsArray: TRationIDsArray;
  890. RCountPriceIDsArray: TRationIDsArray;
  891. lstRations: TList;
  892. begin
  893. Screen.Cursor := crHourGlass;
  894. try
  895. lstBillsID := TList.Create;
  896. lstRations := TList.Create;
  897. Tree := stdRations2.IDTree;
  898. Tree.AutoCreateKeyID := False;
  899. Tree.DeleteAll;
  900. // 通过工料机ID获取定额的ID数组
  901. RationIDsArray := FProject.GLJ.GetRationIDsByGLJID(AGLJID);
  902. // 通过工料机ID获取数量单价的ID数组
  903. RCountPriceIDsArray := FProject.Rations.GetCountPriceIDsByGLJID(AGLJID);
  904. // 合并为一个数组
  905. iLength := Length(RationIDsArray);
  906. SetLength(RationIDsArray, iLength + Length(RCountPriceIDsArray));
  907. CopyMemory(@RationIDsArray[iLength], @RCountPriceIDsArray[0], Length(RCountPriceIDsArray));
  908. // 缓存清单ID
  909. for I := Low(RationIDsArray) to High(RationIDsArray) do
  910. begin
  911. sdRation := FProject.Rations.FindRation(RationIDsArray[I]);
  912. lstRations.Add(sdRation);
  913. lstBillsID.Add(Pointer(sdRation.BillsItemID.AsInteger));
  914. end;
  915. // 遍历定额
  916. for I := 0 to lstRations.Count - 1 do
  917. begin
  918. sdRation := TScRationRecord(lstRations[I]);
  919. if sdRation.FTItemFlag.AsInteger = 1 then Continue;
  920. // 添加所有清单父项
  921. ParentNode := AddParents(sdRation.BillsItemID.AsInteger);
  922. Node := Tree.Add(10000000 + sdRation.ID.AsInteger, ParentNode.ID, -1, True);
  923. Rec := Node.Rec;
  924. try
  925. Rec.ValueByName(SCode).AsString := sdRation.Code.AsString;
  926. Rec.ValueByName(SName).AsString := sdRation.Name.AsString;
  927. Rec.ValueByName(SBillsItemID).AsInteger := sdRation.BillsItemID.AsInteger;
  928. Rec.ValueByName(SUnitPrice).AsCurrency := sdRation.BuildingUnitPrice.AsCurrency;
  929. Rec.ValueByName('IsRation').AsBoolean := True;
  930. Rec.ValueByName(SRationID).AsInteger := sdRation.ID.AsInteger;
  931. Rec.ValueByName(SSerialNo).AsInteger := sdRation.SerialNo.AsInteger;
  932. finally
  933. Rec.EndUpdate;
  934. end;
  935. end;
  936. ResortRations(Tree.FirstNode);
  937. finally
  938. Screen.Cursor := crDefault;
  939. lstBillsID.Free;
  940. lstRations.Free;
  941. end;
  942. end;
  943. procedure TfrmSearchAndReplace.zgRationsShowHint(var HintStr: String;
  944. var CanShow: Boolean; var HintInfo: THintInfo; const ACoord: TPoint);
  945. var
  946. iActiveRec: Integer;
  947. sHint: string;
  948. begin
  949. iActiveRec := ACoord.Y - zgRations.FixedRowCount;
  950. begin
  951. if ACoord.X = 1 then
  952. sHint := '双击定位';
  953. CanShow := True;
  954. HintInfo.HintMaxWidth := 300;
  955. HintStr := sHint;
  956. end;
  957. if RADM = nil then
  958. Exit;
  959. if zdRations.ChangeActiveRecord(iActiveRec, iActiveRec) then
  960. try
  961. if ACoord.X = 2 then
  962. begin
  963. if zdRations.DataSet.FieldByName('Type').AsInteger = 0 then
  964. sHint := FRADM.LookupRationGLJ(zdRations.DataSet.FieldByName('Code').AsString)
  965. // 数量单价类
  966. else
  967. sHint := '数量单价类';
  968. HintInfo.HideTimeout := 30000;
  969. if sHint <> '' then
  970. begin
  971. CanShow := True;
  972. HintInfo.HintMaxWidth := 300;
  973. HintStr := sHint;
  974. end;
  975. end;
  976. finally
  977. zdRations.ChangeActiveRecord(iActiveRec, iActiveRec);
  978. end;
  979. end;
  980. procedure TfrmSearchAndReplace.zgRations2ShowHint(var HintStr: String;
  981. var CanShow: Boolean; var HintInfo: THintInfo; const ACoord: TPoint);
  982. var
  983. iActiveRec: Integer;
  984. sHint: string;
  985. Node: TsdIDTreeNode;
  986. begin
  987. iActiveRec := ACoord.Y - zgRations2.FixedRowCount;
  988. begin
  989. if ACoord.X = 1 then
  990. sHint := '双击定位';
  991. CanShow := True;
  992. HintInfo.HintMaxWidth := 300;
  993. HintStr := sHint;
  994. end;
  995. if RADM = nil then
  996. Exit;
  997. Node := stdRations2.IDTree.Items[iActiveRec];
  998. if Node <> nil then
  999. if ACoord.X = 2 then
  1000. begin
  1001. // Modified by GiLi 2012-3-15 19:14:48
  1002. // 犹豫数量单价的定额号不是标准的定额编号,而是等于工料机的编号
  1003. // 所以,Hint不能用原来的,不然会弹出提示框“定额号需大于或等于8位数字。请重新输入”
  1004. if Node.Rec.ValueByName('IsRation').AsBoolean then
  1005. begin
  1006. if 0 <> CompareText(cdsGLJCode.AsString, Node.Rec.ValueByName(SCode).AsString) then
  1007. begin
  1008. sHint := FRADM.LookupRationGLJ(Node.Rec.ValueByName(SCode).AsString);
  1009. HintInfo.HideTimeout := 30000;
  1010. if sHint <> '' then
  1011. begin
  1012. CanShow := True;
  1013. HintInfo.HintMaxWidth := 300;
  1014. HintStr := sHint;
  1015. end;
  1016. end
  1017. else
  1018. begin
  1019. // Modified by GiLi 2012-3-15 19:41:29
  1020. HintStr := '编号: ' + cdsGLJCode.AsString + #13#10 + '名称: ' + cdsGLJName.AsString + #13#10
  1021. + '规格: ' + cdsGLJSpecs.AsString + #13#10 + '单位: ' + cdsGLJUnit.AsString + #13#10
  1022. + '单价: ' + FloatToStr(ScRoundTo(cdsGLJBudgetPrice.AsFloat, -2));
  1023. end;
  1024. end;
  1025. end;
  1026. end;
  1027. procedure TfrmSearchAndReplace.SearchBillsByB_Code(AValue: String);
  1028. var
  1029. vItem: TScBillsItem;
  1030. SNo2, i: Integer;
  1031. procedure addBill;
  1032. begin
  1033. cdsBills.Append;
  1034. if vItem.Rec.SerialNo.AsInteger > SNo2 then
  1035. cdsBillsIsME.AsBoolean := True
  1036. else
  1037. cdsBillsIsME.AsBoolean := False;
  1038. with vItem.Rec do
  1039. begin
  1040. cdsBillsSerialNo.AsVariant := SerialNo.AsVariant;
  1041. cdsBillsID.AsInteger := ID.AsInteger;
  1042. cdsBillsB_Code.AsVariant := B_Code.AsVariant;
  1043. cdsBillsName.AsVariant := Name.AsVariant;
  1044. cdsBillsQuantity.AsVariant := Quantity.AsVariant;
  1045. cdsBillsUnitPrice.AsVariant := UnitPrice.AsVariant;
  1046. cdsBillsTotalPrice.AsVariant := TotalPrice.AsVariant;
  1047. end;
  1048. {// Chenshilong, 2010-3-28 12:31:25
  1049. 以下这段严重影响效率,先屏蔽。
  1050. while (vBillItem <> nil) and (vBillItem.Code = '') do
  1051. vBillItem := TScBillsItem(vBillItem.Parent);
  1052. if vBillItem <> nil then
  1053. cdsBills2Code.AsString := vBillItem.Code; }
  1054. cdsBills.Post;
  1055. end;
  1056. begin
  1057. SNo2 := TScBillsItem(FProject.Bills.BillsTree[2]).Rec.SerialNo.AsInteger;
  1058. for i := 0 to FProject.Bills.BillsTree.Count - 1 do
  1059. begin
  1060. vItem := FProject.Bills.BillsTree.Items[i];
  1061. if vItem.B_Code <> '' then
  1062. begin
  1063. if ((AValue = '') or (Pos(AValue, vItem.B_Code) = 1))
  1064. and (vItem.Rec.IsLeaf.AsBoolean = True) then
  1065. addBill;
  1066. end;
  1067. end;
  1068. end;
  1069. procedure TfrmSearchAndReplace.DoOnBillsScroll(DataSet: TDataSet);
  1070. begin
  1071. if FProject.IsGuangDong then
  1072. begin
  1073. if not chkLocateFirstAppear.Checked then Exit;
  1074. if FBillsTree.Selected = nil then Exit;
  1075. if TScBillsItem(FBillsTree.Selected).B_Code <> '' then
  1076. cdsBills.Locate('B_Code', TScBillsItem(FBillsTree.Selected).B_Code, []);
  1077. end;
  1078. end;
  1079. procedure TfrmSearchAndReplace.btnSearchRationClick(Sender: TObject);
  1080. begin
  1081. cdsRations.EmptyDataSet;
  1082. if rbRationName.Checked then
  1083. SearchRations(Trim(edtSearch.Text), skName)
  1084. else if rbRationCode.Checked then
  1085. SearchRations(Trim(edtSearch.Text), skCode);
  1086. end;
  1087. procedure TfrmSearchAndReplace.edtSearchKeyDown(Sender: TObject;
  1088. var Key: Word; Shift: TShiftState);
  1089. begin
  1090. if key = VK_Return then
  1091. btnSearch.Click;
  1092. end;
  1093. procedure TfrmSearchAndReplace.btnSearchClick(Sender: TObject);
  1094. begin
  1095. SearchRecords(Trim(edtSearch.Text));
  1096. end;
  1097. procedure TfrmSearchAndReplace.SearchGLJs(AValue: String;
  1098. ASearchKind: TSearchKind);
  1099. var
  1100. I: Integer;
  1101. Rec: TScProjectGLJRecord;
  1102. sFiledValue: string;
  1103. evt: TDataSetNotifyEvent;
  1104. begin
  1105. evt := cdsGLJ.AfterScroll;
  1106. cdsGLJ.AfterScroll := nil;
  1107. cdsGLJ.DisableControls;
  1108. Screen.Cursor := crHourGlass;
  1109. try
  1110. for I := 0 to FProject.ProjectGLJ.sdsProjectGLJ.RecordCount - 1 do
  1111. begin
  1112. Rec := FProject.ProjectGLJ.GLJ[I];
  1113. case ASearchKind of
  1114. skCode: sFiledValue := Rec.Code.AsString;
  1115. skName: sFiledValue := Rec.Name.AsString;
  1116. end;
  1117. if (AValue = '') or (Pos(AValue, sFiledValue) > 0) then
  1118. begin
  1119. cdsGLJ.Append;
  1120. cdsGLJCode.AsString := Rec.Code.AsString;
  1121. cdsGLJName.AsString := Rec.Name.AsString;
  1122. cdsGLJID.AsInteger := Rec.ID.AsInteger;
  1123. cdsGLJLibID.AsInteger := Rec.LibID.AsInteger;
  1124. cdsGLJUnit.AsString := ConvertUnitStr(Rec.Units.AsString);
  1125. cdsGLJSpecs.AsString := Rec.Specs.AsString;
  1126. cdsGLJBudgetPrice.AsFloat:= Rec.BudgetPrice.AsFloat;
  1127. cdsGLJ.Post;
  1128. end;
  1129. end;
  1130. cdsGLJ.First;
  1131. if (not cdsGLJ.Active) or (cdsGLJ.RecordCount < 1) then
  1132. begin
  1133. stdRations2.IDTree.DeleteAll;
  1134. Exit;
  1135. end;
  1136. SearchRationsByGLJ(cdsGLJID.AsInteger);
  1137. finally
  1138. cdsGLJ.AfterScroll := evt;
  1139. cdsGLJ.EnableControls;
  1140. Screen.Cursor := crDefault;
  1141. end;
  1142. end;
  1143. procedure TfrmSearchAndReplace.zgBillsShowHint(var HintStr: String;
  1144. var CanShow: Boolean; var HintInfo: THintInfo; const ACoord: TPoint);
  1145. var i: Integer;
  1146. begin
  1147. if FProject.IsGuangDong then
  1148. i := 2
  1149. else
  1150. i := 1;
  1151. if ACoord.x = i then
  1152. begin
  1153. CanShow := True;
  1154. HintInfo.HintMaxWidth := 300;
  1155. HintStr := '双击定位';
  1156. end;
  1157. end;
  1158. procedure TfrmSearchAndReplace.cdsGLJAfterScroll(DataSet: TDataSet);
  1159. begin
  1160. if not cdsGLJ.Active then Exit;
  1161. if cdsGLJ.RecordCount < 1 then Exit;
  1162. sdsRations2.DeleteAll;
  1163. SearchRationsByGLJ(cdsGLJID.AsInteger);
  1164. end;
  1165. procedure TfrmSearchAndReplace.SetProject(const Value: TScProject);
  1166. begin
  1167. FProject := Value;
  1168. FRADM.InitData(FProject.RationLibs);
  1169. Init(Value);
  1170. end;
  1171. procedure TfrmSearchAndReplace.RadioButtonCheck;
  1172. begin
  1173. if rbBillB_Code.Checked then
  1174. begin
  1175. pcSAndR.ActivePage := PageBill;
  1176. ReplaceEnable(False);
  1177. AboveAverageEnable(True);
  1178. end
  1179. else if rbBillCode.Checked then
  1180. begin
  1181. pcSAndR.ActivePage := PageBill;
  1182. ReplaceEnable(False);
  1183. AboveAverageEnable(True);
  1184. end
  1185. else if rbBillName.Checked then
  1186. begin
  1187. pcSAndR.ActivePage := PageBill;
  1188. // ReplaceEnable(True);
  1189. if FProject.IsGuangDong then
  1190. // AboveAverageEnable(False)
  1191. AboveAverageEnable(True)
  1192. else
  1193. if FProject.ProjType = ptBudget then
  1194. AboveAverageEnable(True);
  1195. end
  1196. else if rbRationCode.Checked then
  1197. begin
  1198. pcSAndR.ActivePage := PageRation;
  1199. ReplaceEnable(False);
  1200. AboveAverageEnable(False);
  1201. end
  1202. else if rbRationName.Checked or rbCountPrice.Checked or rbDevices.Checked then
  1203. begin
  1204. pcSAndR.ActivePage := PageRation;
  1205. // ReplaceEnable(True);
  1206. AboveAverageEnable(False);
  1207. end
  1208. else if rbGLJCode.Checked then
  1209. begin
  1210. pcSAndR.ActivePage := PageGLJ;
  1211. ReplaceEnable(False);
  1212. AboveAverageEnable(False);
  1213. end
  1214. else if rbGLJName.Checked then
  1215. begin
  1216. pcSAndR.ActivePage := PageGLJ;
  1217. ReplaceEnable(False);
  1218. AboveAverageEnable(False);
  1219. end
  1220. else if rbBookmark.Checked then
  1221. begin
  1222. pcSAndR.ActivePage := PageBookmark;
  1223. ReplaceEnable(False);
  1224. AboveAverageEnable(False);
  1225. RefreshBookmarkStr(sdvBookMark.Current);
  1226. end;
  1227. SearchRecords(edtSearch.Text);
  1228. if edtSearch.CanFocus then
  1229. edtSearch.SetFocus;
  1230. end;
  1231. procedure TfrmSearchAndReplace.rbBillB_CodeClick(Sender: TObject);
  1232. begin
  1233. RadioButtonCheck;
  1234. end;
  1235. procedure TfrmSearchAndReplace.rbBillNameClick(Sender: TObject);
  1236. begin
  1237. RadioButtonCheck;
  1238. end;
  1239. procedure TfrmSearchAndReplace.rbRationCodeClick(Sender: TObject);
  1240. begin
  1241. RadioButtonCheck;
  1242. end;
  1243. procedure TfrmSearchAndReplace.rbRationNameClick(Sender: TObject);
  1244. begin
  1245. RadioButtonCheck;
  1246. end;
  1247. procedure TfrmSearchAndReplace.rbGLJCodeClick(Sender: TObject);
  1248. begin
  1249. RadioButtonCheck;
  1250. end;
  1251. procedure TfrmSearchAndReplace.rbGLJNameClick(Sender: TObject);
  1252. begin
  1253. RadioButtonCheck;
  1254. end;
  1255. constructor TfrmSearchAndReplace.Create(AOwner: TComponent);
  1256. begin
  1257. inherited;
  1258. FRADM := TRationAssistantDM.Create(nil);
  1259. pnlColorSet.Visible := btnColorView.Down;
  1260. end;
  1261. destructor TfrmSearchAndReplace.Destroy;
  1262. begin
  1263. FRADM.Free;
  1264. AggUnitPrice.Free;
  1265. inherited;
  1266. end;
  1267. procedure TfrmSearchAndReplace.ReplaceEnable(AEnable: Boolean);
  1268. begin
  1269. pnReplace.Visible := AEnable;
  1270. end;
  1271. procedure TfrmSearchAndReplace.SearchRecords(SearchText: string);
  1272. begin
  1273. if rbBillName.Checked then
  1274. begin
  1275. cdsBills.EmptyDataSet;
  1276. if Project.IsGuangDong then
  1277. cdsBills.IndexName := 'IdxNameBCode'
  1278. else
  1279. cdsBills.IndexName := 'IdxName';
  1280. SearchBills(SearchText, skName, True);
  1281. end
  1282. else if rbBillB_Code.Checked then
  1283. begin
  1284. cdsBills.EmptyDataSet;
  1285. cdsBills.IndexName := 'IdxBCodeCode';
  1286. SearchBills(SearchText, skB_Code);
  1287. end
  1288. else if rbBillCode.Checked then
  1289. begin
  1290. cdsBills.EmptyDataSet;
  1291. cdsBills.IndexName := 'IdxCode';
  1292. SearchBills(SearchText, skCode);
  1293. end
  1294. else if rbRationName.Checked or rbCountPrice.Checked or rbDevices.Checked then
  1295. begin
  1296. cdsRations.EmptyDataSet;
  1297. SearchRations(SearchText, skName);
  1298. end
  1299. else if rbRationCode.Checked then
  1300. begin
  1301. cdsRations.EmptyDataSet;
  1302. SearchRations(SearchText, skCode);
  1303. end
  1304. else if rbGLJName.Checked then
  1305. begin
  1306. cdsGLJ.EmptyDataSet;
  1307. sdsRations2.DeleteAll;
  1308. SearchGLJs(SearchText, skName);
  1309. end
  1310. else if rbGLJCode.Checked then
  1311. begin
  1312. cdsGLJ.EmptyDataSet;
  1313. sdsRations2.DeleteAll;
  1314. SearchGLJs(SearchText, skCode);
  1315. end
  1316. else if rbBookmark.Checked then
  1317. begin
  1318. { if SearchText = '' then
  1319. begin
  1320. Exit;
  1321. end
  1322. else }
  1323. SearchBookmarks;
  1324. end;
  1325. end;
  1326. procedure TfrmSearchAndReplace.edtAboveAverageKeyPress(Sender: TObject;
  1327. var Key: Char);
  1328. begin
  1329. if not (Key in ['0'..'9', #8, #13]) then
  1330. Key := #0;
  1331. end;
  1332. procedure TfrmSearchAndReplace.zgBillsCellGetColor(Sender: TObject;
  1333. ACoord: TPoint; var AColor: TColor);
  1334. var
  1335. OldActiveRecd: Integer;
  1336. dPrice, dAggValue, dPer, dPerValue: Double;
  1337. begin
  1338. if chkAboveAverage.Enabled and chkAboveAverage.Checked then
  1339. begin
  1340. if edtAboveAverage.Text = '' then Exit;
  1341. if zdBills.ChangeActiveRecord(ACoord.Y - zgBills.FixedRowCount, OldActiveRecd)then
  1342. begin
  1343. { 突出显示业务:
  1344. 当前单价Pn:P1、P2、P3....
  1345. 平均单价P:Pn取平均价。
  1346. 平均值V:P * x% (x是用户输入的值)
  1347. 如果当前记录的 |(Pn - P)| > V,则标黄。
  1348. }
  1349. dPer := StrToFloat(edtAboveAverage.Text);
  1350. if AggUnitPrice.Value = null then
  1351. dAggValue := 0
  1352. else
  1353. dAggValue := AggUnitPrice.Value;
  1354. dPerValue := dAggValue * (dPer / 100);
  1355. if Project.IsBudget then
  1356. dPrice := zdBills.DataSet.FieldByName('DesignPrice').AsFloat // 概预算
  1357. else
  1358. dPrice := zdBills.DataSet.FieldByName('UnitPrice').AsFloat;
  1359. try
  1360. if Abs(dPrice - dAggValue) > dPerValue then
  1361. AColor := $008EFFFF;
  1362. finally
  1363. zdBills.ChangeActiveRecord(OldActiveRecd, OldActiveRecd);
  1364. end;
  1365. end;
  1366. end;
  1367. end;
  1368. procedure TfrmSearchAndReplace.edtAboveAverageExit(Sender: TObject);
  1369. var ini: TIniFile;
  1370. begin
  1371. if edtAboveAverage.Modified then
  1372. begin
  1373. if Trim(edtAboveAverage.Text) = '' then
  1374. begin
  1375. ShowMessage('百分比值必须指定,不能为空!');
  1376. edtAboveAverage.SetFocus;
  1377. edtAboveAverage.SelectAll;
  1378. Exit;
  1379. end;
  1380. try
  1381. StrToFloat(edtAboveAverage.Text);
  1382. except
  1383. ShowMessage('百分比值错误,请修正!');
  1384. edtAboveAverage.SetFocus;
  1385. edtAboveAverage.SelectAll;
  1386. Exit;
  1387. end;
  1388. ini:= TIniFile.Create(ConfigInfo.SystemIniFileName);
  1389. try
  1390. ini.WriteString('Options','AboveAveragePercent', edtAboveAverage.Text);
  1391. finally
  1392. ini.Free;
  1393. end;
  1394. end;
  1395. end;
  1396. procedure TfrmSearchAndReplace.AboveAverageEnable(AEnable: Boolean);
  1397. begin
  1398. lblAboveAverage.Enabled := AEnable;
  1399. edtAboveAverage.Enabled := AEnable;
  1400. chkAboveAverage.Enabled := AEnable;
  1401. end;
  1402. procedure TfrmSearchAndReplace.rbBookmarkClick(Sender: TObject);
  1403. begin
  1404. RadioButtonCheck;
  1405. end;
  1406. procedure TfrmSearchAndReplace.SearchBookmarks;
  1407. begin
  1408. sdvBookMark.Filtered := False;
  1409. sdvBookmark.Filtered := True;
  1410. sdvBookmark.IndexName := 'idxSerialNo';
  1411. //if mmBM.Visible and mmBM.CanFocus then
  1412. // mmBM.SetFocus;
  1413. end;
  1414. procedure TfrmSearchAndReplace.zgBookmarkMouseDown(Sender: TObject;
  1415. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1416. begin
  1417. if ssDouble in Shift then
  1418. LocateCurBills;
  1419. end;
  1420. procedure TfrmSearchAndReplace.mmBMExit(Sender: TObject);
  1421. begin
  1422. if mmBM.Text = sDefStr then
  1423. begin
  1424. Exit;
  1425. end
  1426. else
  1427. begin
  1428. if sdvBookmark.RecordCount = 0 then
  1429. begin
  1430. if FProject.ProjType = ptBudget then
  1431. MessageHint(0, '无法定位,您未设置分项书签,不能设置批注!')
  1432. else
  1433. MessageHint(0, '无法定位,您未设置清单书签,不能设置批注!');
  1434. mmBM.Clear;
  1435. Exit;
  1436. end;
  1437. TScBillsRecord(sdvBookMark.Current).BookmarkStr.AsString := mmBM.Text;
  1438. end;
  1439. // if sdvBookMark.State in [dsInsert, dsEdit] then
  1440. // cdsBookmark.Post;
  1441. end;
  1442. procedure TfrmSearchAndReplace.mnClearAllBMClick(Sender: TObject);
  1443. var i: Integer;
  1444. begin
  1445. if Application.MessageBox('确定要删除所有书签批注吗?', '询问', MB_YESNO + MB_ICONQUESTION) = ID_No then
  1446. Exit;
  1447. while sdvBookMark.RecordCount > 0 do
  1448. DeleteBookMark(TScBillsRecord(sdvBookMark.Records[0]));
  1449. end;
  1450. procedure TfrmSearchAndReplace.mnClearCurBMClick(Sender: TObject);
  1451. begin
  1452. if sdvBookMark.RecordCount = 0 then Exit;
  1453. DeleteBookMark(TScBillsRecord(sdvBookMark.Current));
  1454. end;
  1455. procedure TfrmSearchAndReplace.btnSearchAllClick(Sender: TObject);
  1456. begin
  1457. SearchRecords('');
  1458. end;
  1459. procedure TfrmSearchAndReplace.FilterME(AOnlyME: Boolean);
  1460. begin
  1461. end;
  1462. procedure TfrmSearchAndReplace.chkOnlyMEClick(Sender: TObject);
  1463. begin
  1464. RadioButtonCheck;
  1465. end;
  1466. procedure TfrmSearchAndReplace.chkAboveAverageClick(Sender: TObject);
  1467. begin
  1468. RadioButtonCheck;
  1469. end;
  1470. procedure TfrmSearchAndReplace.cdsBillsDesignQuantityGetText(
  1471. Sender: TField; var Text: String; DisplayText: Boolean);
  1472. begin
  1473. if Sender.Value = 0 then
  1474. Text := ''
  1475. else
  1476. Text := VarToStr(Sender.Value);
  1477. end;
  1478. procedure TfrmSearchAndReplace.mmBMEnter(Sender: TObject);
  1479. begin
  1480. if mmBM.Text = sDefStr then
  1481. //mmBM.SelectAll;
  1482. mmBM.Text := '';
  1483. end;
  1484. procedure TfrmSearchAndReplace.DeleteBookMark(ARec: TScBillsRecord);
  1485. begin
  1486. ARec.BeginUpdate;
  1487. ARec.BookmarkStr.AsString := '';
  1488. ARec.HaveBookmark.AsBoolean := False;
  1489. ARec.BookmarkColor.AsInteger := 0;
  1490. ARec.EndUpdate;
  1491. end;
  1492. procedure TfrmSearchAndReplace.zgColorCellGetColor(Sender: TObject;
  1493. ACoord: TPoint; var AColor: TColor);
  1494. var
  1495. OldActiveRecd: Integer;
  1496. vColor: TColor;
  1497. begin
  1498. if ACoord.X = 0 then
  1499. begin
  1500. if zaColor.ChangeActiveRecord(ACoord.Y - zgColor.FixedRowCount, OldActiveRecd)then
  1501. begin
  1502. vColor := TColor(zaColor.DataSet.FieldByName('BMColor').AsInteger);
  1503. try
  1504. AColor := vColor;
  1505. finally
  1506. zaColor.ChangeActiveRecord(OldActiveRecd, OldActiveRecd);
  1507. end;
  1508. end;
  1509. end;
  1510. end;
  1511. procedure TfrmSearchAndReplace.btnColorViewClick(Sender: TObject);
  1512. begin
  1513. pnlColorSet.Visible := btnColorView.Down;
  1514. end;
  1515. procedure TfrmSearchAndReplace.zgBookmarkCellGetColor(Sender: TObject;
  1516. ACoord: TPoint; var AColor: TColor);
  1517. var
  1518. vRec: TsdDataRecord;
  1519. vColor: TColor;
  1520. begin
  1521. // vColor := sgdBookmark.DataView.Current.ValueByName('BookMarkColor').AsInteger;
  1522. vRec := sgdBookmark.DataView.Records[ACoord.Y - zgBookmark.FixedRowCount];
  1523. if vRec <> nil then
  1524. begin
  1525. vColor := vRec.ValueByName('BookMarkColor').AsInteger;
  1526. if vColor = 0 then // 兼容旧书签颜色
  1527. vColor := $00CEE7FF;
  1528. AColor := vColor;
  1529. end;
  1530. end;
  1531. procedure TfrmSearchAndReplace.zgColorMouseDown(Sender: TObject;
  1532. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1533. begin
  1534. if (zgColor.CurCol = 0) and (Button = mbLeft) and (ssDouble in Shift) then
  1535. begin
  1536. SetDefaultColor;
  1537. end;
  1538. end;
  1539. procedure TfrmSearchAndReplace.SetDefaultColor;
  1540. var vColor: TColor;
  1541. procedure ExecMySQL(ASQL: string);
  1542. begin
  1543. aqSQL.Close;
  1544. aqSQL.SQL.Clear;
  1545. aqSQL.SQL.Add(ASQL);
  1546. aqSQL.ExecSQL;
  1547. end;
  1548. begin
  1549. vColor := TColor(zaColor.DataSet.FieldByName('BMColor').AsInteger);
  1550. pnlDefaultColor.Color := vColor;
  1551. // lblDefaultColor.Font.Color := vColor;
  1552. ExecMySQL('Update BookMarkColor set CurColor = Null');
  1553. ExecMySQL(Format('Update BookMarkColor set CurColor = 1 where BMColor = %d', [Integer(vColor)]));
  1554. aqBookMarkColor.Refresh;
  1555. FProject.BookMarkColor := vColor;
  1556. end;
  1557. procedure TfrmSearchAndReplace.zgColorShowHint(var HintStr: String;
  1558. var CanShow: Boolean; var HintInfo: THintInfo; const ACoord: TPoint);
  1559. begin
  1560. if ACoord.X = 0 then
  1561. begin
  1562. HintInfo.HintStr := '双击设为默认书签颜色';
  1563. CanShow := True;
  1564. HintInfo.HintMaxWidth := 250;
  1565. HintInfo.HideTimeout := 30000;
  1566. end;
  1567. end;
  1568. procedure TfrmSearchAndReplace.rbAllClick(Sender: TObject);
  1569. begin
  1570. FilterColor;
  1571. end;
  1572. procedure TfrmSearchAndReplace.FilterColor;
  1573. var vColor: Integer;
  1574. begin
  1575. // if rbAll.Checked then
  1576. // begin
  1577. // cdsBookMark.Filter := 'HaveBookmark';
  1578. // cdsBookMark.Filtered := True;
  1579. // end
  1580. // else
  1581. // begin
  1582. // vColor := aqBookMarkColorBMColor.AsInteger;
  1583. // cdsBookMark.Filter := Format('HaveBookmark and (BookMarkColor=%d)', [vColor]);
  1584. // cdsBookMark.Filtered := True;
  1585. // end;
  1586. end;
  1587. procedure TfrmSearchAndReplace.rbOnlyCurClick(Sender: TObject);
  1588. begin
  1589. FilterColor;
  1590. end;
  1591. procedure TfrmSearchAndReplace.aqBookMarkColorAfterScroll(
  1592. DataSet: TDataSet);
  1593. begin
  1594. FilterColor;
  1595. end;
  1596. procedure TfrmSearchAndReplace.sdvBookMarkFilterRecord(
  1597. ARecord: TsdDataRecord; var Allow: Boolean);
  1598. begin
  1599. if TScBillsRecord(ARecord).HaveBookmark.AsBoolean = True then
  1600. Allow := True
  1601. else
  1602. Allow := False;
  1603. end;
  1604. procedure TfrmSearchAndReplace.sdvBookMarkCurrentChanged(
  1605. ARecord: TsdDataRecord);
  1606. begin
  1607. RefreshBookmarkStr(ARecord);
  1608. end;
  1609. procedure TfrmSearchAndReplace.RefreshBookmarkStr(ARecord: TsdDataRecord);
  1610. begin
  1611. if ARecord = nil then
  1612. begin
  1613. mmBM.Text := '';
  1614. Exit;
  1615. end;
  1616. mmBM.Text := TScBillsRecord(ARecord).BookmarkStr.AsString;
  1617. if mmBM.Text = '' then
  1618. mmBM.Text := sDefStr;
  1619. if SameText(mmBM.Text, sDefStr) then
  1620. mmBM.Font.Color := clGrayText
  1621. else
  1622. mmBM.Font.Color := clWindowText;
  1623. end;
  1624. procedure TfrmSearchAndReplace.mmBMChange(Sender: TObject);
  1625. begin
  1626. if not SameText(mmBM.Text, sDefStr) then
  1627. mmBM.Font.Color := clWindowText;
  1628. end;
  1629. procedure TfrmSearchAndReplace.zgCompareXMLMouseDown(Sender: TObject;
  1630. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1631. // vGridBill.CurCol := ScMainForm.ActiveChild.BillsView.stdBills.ColumnIndex('DesignQuantity')
  1632. // 上面这种方式不行,当有字段隐藏时,定位会错位。所以这里写个方法定死。
  1633. function GetFocusCol(AFieldName: string): Integer;
  1634. begin
  1635. if Project.ProjType = ptBillsBudget then
  1636. begin
  1637. if AFieldName = 'Quantity' then
  1638. Result := 5
  1639. else if AFieldName = 'DesignQuantity' then
  1640. Result := 6
  1641. else if AFieldName = 'DesignQuantity2' then
  1642. Result := 7
  1643. end
  1644. else if Project.ProjType = ptBills then
  1645. begin
  1646. if AFieldName = 'Quantity' then
  1647. Result := 4
  1648. else
  1649. Result := 1
  1650. end
  1651. else if Project.ProjType in [ptBudget, ptBudgetEstimate, ptFeasibilityEstimate, ptProposalEstimate] then
  1652. begin
  1653. if AFieldName = 'DesignQuantity' then
  1654. Result := 4
  1655. else if AFieldName = 'DesignQuantity2' then
  1656. Result := 5
  1657. else
  1658. Result := 1;
  1659. end;
  1660. end;
  1661. var vNode: TScBillsItem;
  1662. vGridBill, vGridRation: TZJGrid;
  1663. sValue: string;
  1664. begin
  1665. if ssDouble in Shift then
  1666. begin
  1667. if cdsCompareXML.RecordCount = 0 then Exit;
  1668. vNode := FProject.Bills.BillsTree[cdsCompareXMLBillID.AsInteger];
  1669. if vNode <> nil then
  1670. begin
  1671. // 先定位到清单级别
  1672. if not vNode.Expanded then
  1673. vNode.Expanded := True;
  1674. vNode.LocateInControl;
  1675. vGridBill := ScMainForm.ActiveChild.BillsView.zgBills;
  1676. if SameText(cdsCompareXMLKind.AsString, '分项') or SameText(cdsCompareXMLKind.AsString, '清单') then
  1677. begin
  1678. sValue := cdsCompareXMLQuantity.AsString;
  1679. if Pos('设一', sValue) > 0 then
  1680. vGridBill.CurCol := GetFocusCol('DesignQuantity')
  1681. else if Pos('设二', sValue) > 0 then
  1682. vGridBill.CurCol := GetFocusCol('DesignQuantity2')
  1683. else if Pos('数量', sValue) > 0 then
  1684. vGridBill.CurCol := GetFocusCol('Quantity')
  1685. else
  1686. vGridBill.CurCol := 1;
  1687. vGridBill.SetFocus;
  1688. end
  1689. else if SameText(cdsCompareXMLKind.AsString, '定额') then
  1690. begin
  1691. if cdsCompareXMLRationID.IsNull then
  1692. MessageHint(0, '定额已被删除,无法定位。当前定位到删除前所在的清单。')
  1693. else
  1694. begin
  1695. FProject.Rations.LocateRation(cdsCompareXMLRationID.AsInteger);
  1696. vGridBill.CurCol := 1;
  1697. vGridRation := ScMainForm.ActiveChild.BillsSubItemView.zgRations;
  1698. vGridRation.CurCol := 6;
  1699. ScMainForm.ActiveChild.BillsSubItemView.PageControl.ActivePageIndex := 0;
  1700. vGridRation.SetFocus;
  1701. end;
  1702. end
  1703. else if SameText(cdsCompareXMLKind.AsString, '图纸') then
  1704. begin
  1705. FProject.Bills.DrawingQuantityDM.LocateDrawQty(cdsCompareXMLBillID.AsInteger, cdsCompareXMLDrawQtyID.AsInteger);
  1706. end;
  1707. end
  1708. else
  1709. begin
  1710. MessageHint(0, '清单已被删除,无法定位。');
  1711. end;
  1712. end;
  1713. end;
  1714. procedure TfrmSearchAndReplace.zgCompareXMLCellGetFont(Sender: TObject;
  1715. ACoord: TPoint; AFont: TFont);
  1716. var
  1717. OldActiveRecd: Integer;
  1718. sValue: string;
  1719. begin
  1720. if zaCompareXML.ChangeActiveRecord(ACoord.Y - zgCompareXML.FixedRowCount, OldActiveRecd)then
  1721. begin
  1722. sValue := zaCompareXML.DataSet.FieldByName('Operate').AsString;
  1723. try
  1724. if (sValue = '增加') then
  1725. AFont.Color := clBlue
  1726. else if (sValue = '删除') then
  1727. AFont.Color := $006060FF;
  1728. finally
  1729. zaCompareXML.ChangeActiveRecord(OldActiveRecd, OldActiveRecd);
  1730. end;
  1731. end;
  1732. end;
  1733. procedure TfrmSearchAndReplace.rbCompareXMLClick(Sender: TObject);
  1734. begin
  1735. pcSAndR.ActivePage := PageCompareXML;
  1736. end;
  1737. procedure TfrmSearchAndReplace.CompareFromXML;
  1738. var
  1739. vPort: TtzslXMLPort;
  1740. vODlg: TOpenDialog;
  1741. sPath, sFile: string;
  1742. begin
  1743. rbCompareXML.Checked := True;
  1744. vODlg := TOpenDialog.Create(nil);
  1745. vODlg.Title := '算量对比';
  1746. vODlg.Filter := '算量对比XML文件(*.XML)|*.XML';
  1747. try
  1748. if vODlg.Execute then
  1749. begin
  1750. vPort := TtzslXMLPort.Create;
  1751. try
  1752. vPort.Project := FProject;
  1753. vPort.XMLFile := vODlg.FileName;
  1754. edtFile.Text := vODlg.FileName;
  1755. vPort.CompareFromXML(cdsCompareXML);
  1756. finally
  1757. vPort.Free;
  1758. end;
  1759. end
  1760. else
  1761. Exit;
  1762. finally
  1763. vODlg.Free;
  1764. end;
  1765. end;
  1766. procedure TfrmSearchAndReplace.Search(SearchText: string;
  1767. AType: TSearchType);
  1768. begin
  1769. edtSearch.Text := SearchText;
  1770. case AType of
  1771. stBilsCode:
  1772. rbBillCode.Checked := True;
  1773. stBillsName:
  1774. rbBillName.Checked := True;
  1775. stRationCode:
  1776. rbRationCode.Checked := True;
  1777. stRationName:
  1778. rbRationName.Checked := True;
  1779. stCountPrice:
  1780. rbCountPrice.Checked := True;
  1781. stDevice:
  1782. rbDevices.Checked := True;
  1783. stGLJCode:
  1784. rbGLJCode.Checked := True;
  1785. stGLJName:
  1786. rbGLJName.Checked := True;
  1787. stBookmark:
  1788. rbBookmark.Checked := True;
  1789. stCompareXML:
  1790. begin
  1791. rbCompareXML.Checked := True;
  1792. pcSAndR.ActivePage := PageCompareXML;
  1793. Exit;
  1794. end;
  1795. end;
  1796. RadioButtonCheck;
  1797. LocateCurBills;
  1798. zgRations2.SetFocus;
  1799. end;
  1800. procedure TfrmSearchAndReplace.zgRations2CellGetColor(Sender: TObject;
  1801. ACoord: TPoint; var AColor: TColor);
  1802. var
  1803. Node: TsdIDTreeNode;
  1804. begin
  1805. Node := stdRations2.IDTree.Items[ACoord.Y - zgRations2.FixedRowCount];
  1806. if Node <> nil then
  1807. begin
  1808. if Node.Rec.ValueByName('IsRation').AsBoolean then
  1809. AColor := clWhite
  1810. else
  1811. AColor := $00F0F0F0;
  1812. end;
  1813. end;
  1814. end.