{******************************************************************************* 单元名称： ScSearchAndReplaceView.pas 单元说明： 查找与替换。 作者时间： Chenshilong, 2010-5-18 22:32:50 *******************************************************************************} unit ScSearchAndReplaceView; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, DB, ADODB, DBClient, ZjGridDBA, ExtCtrls, StdCtrls, ZJGrid, ScProject, ScBills, JimPages, ScUtils, ScRationAssistantDM, ScMessage, IniFiles, DBCtrls, Menus, Buttons, ScBillsDM, sdDB, sdGridDBA, ScConsts, sdGridTreeDBA, sdProvider; type TSearchKind = (skCode, skB_Code, skName); type TfrmSearchAndReplace = class(TFrame) pcSAndR: TJimPageControl; PageBill: TJimPage; zgBills: TZJGrid; PageRation: TJimPage; zgRations: TZJGrid; PageGLJ: TJimPage; Splitter1: TSplitter; zgGLJ: TZJGrid; zgRations2: TZJGrid; cdsBills: TClientDataSet; cdsBillsSerialNo: TIntegerField; cdsBillsID: TIntegerField; cdsBillsB_Code: TWideStringField; cdsBillsCode: TWideStringField; cdsBillsName: TWideStringField; zdBills: TZjGridDBA; zdRations: TZjGridDBA; cdsRations: TClientDataSet; cdsRationsID: TIntegerField; cdsRationsLibID: TIntegerField; cdsRationsCode: TWideStringField; cdsRationsBillsItemID: TIntegerField; cdsRationsMaskName: TWideStringField; cdsRationsName: TWideStringField; cdsRationsUnit: TWideStringField; cdsRationsQuantity: TFloatField; cdsRationsType: TSmallintField; cdsRationsSerialNo: TIntegerField; cdsRationsCodeForReport: TWideStringField; zdGLJ: TZjGridDBA; cdsGLJ: TClientDataSet; cdsGLJID: TIntegerField; cdsGLJLibID: TIntegerField; cdsGLJName: TWideStringField; cdsGLJSpecs: TWideStringField; cdsGLJUnit: TWideStringField; Panel1: TPanel; edtSearch: TEdit; btnSearch: TButton; rbBillB_Code: TRadioButton; rbBillName: TRadioButton; rbRationCode: TRadioButton; rbRationName: TRadioButton; rbGLJCode: TRadioButton; rbGLJName: TRadioButton; Bevel1: TBevel; pnReplace: TPanel; edtReplace: TEdit; btnReplace: TButton; lblReplace: TLabel; Label1: TLabel; cdsGLJBudgetPrice: TFloatField; cdsBillsQuantity: TFloatField; cdsBillsUnitPrice: TFloatField; cdsBillsTotalPrice: TFloatField; chkLocateFirstAppear: TCheckBox; chkAboveAverage: TCheckBox; edtAboveAverage: TEdit; lblAboveAverage: TLabel; Image2: TImage; rbBookmark: TRadioButton; PageBookmark: TJimPage; Splitter2: TSplitter; pmBM: TPopupMenu; mnClearAllBM: TMenuItem; mnClearCurBM: TMenuItem; cdsBillsIsME: TBooleanField; btnSearchAll: TButton; chkOnlyME: TCheckBox; cdsBillsUnits: TWideStringField; rbBillCode: TRadioButton; cdsBillsDesignQuantity: TCurrencyField; cdsBillsDesignPrice: TCurrencyField; Panel2: TPanel; zgBookmark: TZJGrid; zaColor: TZjGridDBA; pnlBM: TPanel; pnlColorSet: TPanel; zgColor: TZJGrid; Panel5: TPanel; pnlDefaultColor: TPanel; btnColorView: TSpeedButton; aqBookMarkColor: TADOQuery; aqBookMarkColorBMColor: TIntegerField; aqBookMarkColorBMMemo: TWideStringField; aqBookMarkColorCurColor: TIntegerField; aqSQL: TADOQuery; Panel3: TPanel; rbAll: TRadioButton; rbOnlyCur: TRadioButton; sdvBookMark: TsdDataView; sdvSearch: TsdDataView; sgdBookmark: TsdGridDBA; mmBM: TMemo; cdsGLJCode: TWideStringField; rbCountPrice: TRadioButton; rbDevices: TRadioButton; cdsRationsFTItemFlag: TBooleanField; cdsRationsIsMeCalc: TBooleanField; pnlSumBill: TPanel; cdsRationsBasePrice: TFloatField; PageCompareXML: TJimPage; zgCompareXML: TZJGrid; zaCompareXML: TZjGridDBA; cdsCompareXML: TClientDataSet; cdsCompareXMLBillID: TIntegerField; cdsCompareXMLRationID: TIntegerField; cdsCompareXMLDrawQtyID: TIntegerField; cdsCompareXMLOperate: TStringField; cdsCompareXMLKind: TStringField; cdsCompareXMLCode: TStringField; cdsCompareXMLB_Code: TStringField; cdsCompareXMLName: TStringField; cdsCompareXMLQuantity: TStringField; cdsCompareXMLDgnQuantity1: TStringField; cdsCompareXMLDgnQuantity2: TStringField; rbCompareXML: TRadioButton; pnlSelectXMLFile: TPanel; btnSelectFile: TSpeedButton; edtFile: TEdit; smpRations2: TsdMemoryProvider; stdRations2: TsdGridTreeDBA; sdsRations2: TsdDataSet; sdvRations2: TsdDataView; pnlSumRation: TPanel; cdsRationsUnitFee: TWideStringField; cdsRationsTotalFee: TFloatField; cdsRationsAdjustState: TWideStringField; cdsRationsUnitPrice: TFloatField; procedure cdsRationsTypeGetText(Sender: TField; var Text: String; DisplayText: Boolean); procedure zgRationsMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure zgBillsMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure btnReplaceClick(Sender: TObject); procedure zgRationsShowHint(var HintStr: String; var CanShow: Boolean; var HintInfo: THintInfo; const ACoord: TPoint); procedure zgRations2ShowHint(var HintStr: String; var CanShow: Boolean; var HintInfo: THintInfo; const ACoord: TPoint); procedure DoOnBillsScroll(DataSet: TDataSet); procedure btnSearchRationClick(Sender: TObject); procedure edtSearchKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure btnSearchClick(Sender: TObject); procedure zgBillsShowHint(var HintStr: String; var CanShow: Boolean; var HintInfo: THintInfo; const ACoord: TPoint); procedure cdsGLJAfterScroll(DataSet: TDataSet); procedure rbBillB_CodeClick(Sender: TObject); procedure rbBillNameClick(Sender: TObject); procedure rbRationCodeClick(Sender: TObject); procedure rbRationNameClick(Sender: TObject); procedure rbGLJCodeClick(Sender: TObject); procedure rbGLJNameClick(Sender: TObject); procedure edtAboveAverageKeyPress(Sender: TObject; var Key: Char); procedure zgBillsCellGetColor(Sender: TObject; ACoord: TPoint; var AColor: TColor); procedure edtAboveAverageExit(Sender: TObject); procedure rbBookmarkClick(Sender: TObject); procedure zgBookmarkMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure mmBMExit(Sender: TObject); procedure mnClearAllBMClick(Sender: TObject); procedure mnClearCurBMClick(Sender: TObject); procedure btnSearchAllClick(Sender: TObject); procedure chkOnlyMEClick(Sender: TObject); procedure chkAboveAverageClick(Sender: TObject); procedure cdsBillsDesignQuantityGetText(Sender: TField; var Text: String; DisplayText: Boolean); procedure mmBMEnter(Sender: TObject); procedure zgColorCellGetColor(Sender: TObject; ACoord: TPoint; var AColor: TColor); procedure btnColorViewClick(Sender: TObject); procedure zgBookmarkCellGetColor(Sender: TObject; ACoord: TPoint; var AColor: TColor); procedure zgColorMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure zgColorShowHint(var HintStr: String; var CanShow: Boolean; var HintInfo: THintInfo; const ACoord: TPoint); procedure rbAllClick(Sender: TObject); procedure rbOnlyCurClick(Sender: TObject); procedure aqBookMarkColorAfterScroll(DataSet: TDataSet); procedure sdvBookMarkFilterRecord(ARecord: TsdDataRecord; var Allow: Boolean); procedure sdvBookMarkCurrentChanged(ARecord: TsdDataRecord); procedure mmBMChange(Sender: TObject); procedure zgCompareXMLMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure zgCompareXMLCellGetFont(Sender: TObject; ACoord: TPoint; AFont: TFont); procedure rbCompareXMLClick(Sender: TObject); procedure zgRations2CellGetColor(Sender: TObject; ACoord: TPoint; var AColor: TColor); private { Private declarations } FBillsTree: TScBillsTree; FProject: TScProject; FRADM: TRationAssistantDM; FAggUnitPrice: TAggregate; procedure LocateCurBills; procedure SetProject(const Value: TScProject); procedure RadioButtonCheck; procedure ReplaceEnable(AEnable: Boolean); procedure AboveAverageEnable(AEnable: Boolean); procedure FilterME(AOnlyME: Boolean); procedure DeleteBookMark(ARec: TScBillsRecord); procedure SetDefaultColor; procedure FilterColor; procedure RefreshBookmarkStr(ARecord: TsdDataRecord); public { Public declarations } procedure Init(AProject: TScProject; AShowBookmark: Boolean = False); property RADM: TRationAssistantDM read FRADM; property Project: TScProject read FProject write SetProject; constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure SearchRations(AValue: String; ASearchKind: TSearchKind); procedure SearchBills(AValue: String; ASearchKind: TSearchKind; OnlyFirstParts: Boolean = False); procedure SearchGLJs(AValue: String; ASearchKind: TSearchKind); procedure SearchBillsByB_Code(AValue: String); procedure SearchRationsByGLJ(AGLJID: Integer); procedure SearchRecords(SearchText: string); procedure SearchBookmarks; procedure CompareFromXML; procedure Search(SearchText: string; AType: TSearchType); property AggUnitPrice: TAggregate read FAggUnitPrice write FAggUnitPrice; end; implementation uses ZjCells, ScRations, ScProjectGLJ, ScGLJ, ScProjFrm, Math, ScConfig, ScProjBaseDM, sdIDTree, ScXMLPort, ScMainFrm, ScBillsSubItemViews; Const sDefStr = '请在此位置输入批注'; {$R *.dfm} procedure TfrmSearchAndReplace.Init(AProject: TScProject; AShowBookmark: Boolean); var ini: TIniFile; begin FBillsTree := AProject.Bills.BillsTree; sdsRations2.Open; sdvRations2.Open; sdsRations2.DeleteAll; // Aggregate cdsBills.AggregatesActive := True; AggUnitPrice := cdsBills.Aggregates.Add; if Project.IsGuangDong then begin AggUnitPrice.IndexName := 'IdxBCodeCode'; // chkOnlyME.Visible := True; end else begin // AggUnitPrice.IndexName := 'IdxName'; 这个索引导致计算的平均值为0，换成Code AggUnitPrice.IndexName := 'IdxCode'; // chkOnlyME.Visible := False; end; AggUnitPrice.GroupingLevel := 1; if Project.IsBudget then AggUnitPrice.Expression := 'Avg(DesignPrice)' // 概预算计算的平均值是0，暂未找到原因 else AggUnitPrice.Expression := 'Avg(UnitPrice)'; AggUnitPrice.Active := True; ini:= TIniFile.Create(ConfigInfo.SystemIniFileName); try edtAboveAverage.Text:=ini.ReadString('Options','AboveAveragePercent','10'); finally ini.Free; end; pcSAndR.ShowTabs := False; pcSAndR.ActivePage := PageBill; // zgRations.CellClass.Cols[3] := TZjCheckBoxCell; cdsBills.IndexDefs.Clear; cdsBills.IndexDefs.Add('IdxBCodeCode', 'B_Code;Code', []); cdsBills.IndexDefs.Add('IdxCode', 'Code', []); cdsBills.IndexDefs.Add('IdxNameBCode', 'Name;B_Code', []); cdsBills.IndexDefs.Add('IdxName', 'Name', []); // 估概算项目、预算项目只有Code，没有B_Code。有设计数量和经济指标，没有数量单价 if Project.IsBudget then begin zdBills.Columns[0].Width := 58; zdBills.Columns[1].Width := 0; zdBills.Columns[4].Width := 0; zdBills.Columns[5].Width := 0; zdBills.Columns[6].Width := 50; zdBills.Columns[7].Width := 50; zdBills.Columns[0].Title.Caption := '预算项目节'; zdBills.Columns[2].title.caption:= '分项名称'; cdsBills.IndexName := 'IdxCode'; rbBillCode.Caption := '预算项目节'; rbBillCode.Visible := True; rbBillB_Code.Visible := False; if AShowBookmark then rbBookmark.Checked := True else rbBillCode.Checked := True; end else if Project.IsGD3J then begin zdBills.Columns[0].Width := 0; zdBills.Columns[1].Width := 58; zdBills.Columns[4].Width := 50; zdBills.Columns[5].Width := 50; zdBills.Columns[6].Width := 0; zdBills.Columns[7].Width := 0; zdBills.Columns[0].Title.Caption := '预算项目节'; zdBills.Columns[2].Title.Caption := '清单名称'; cdsBills.IndexName := 'IdxBCodeCode'; rbBillB_Code.Visible := True; rbBillCode.Visible := False; if AShowBookmark then rbBookmark.Checked := True else rbBillB_Code.Checked := True; // 广东版要点击清单反向定位到按清单子目号查找定位的窗口中。 // 新控件这个地方不好实现，先不管。chenshilongWaiting // FProject.Bills.BillsDM.OnBillsAfterScrollForSearch := DoOnBillsScroll; // chkLocateFirstAppear.Visible := True; end else begin rbBillB_Code.Visible := False; rbBillCode.Visible := True; if AShowBookmark then rbBookmark.Checked := True else rbGLJCode.Checked := True; cdsBills.IndexName := 'IdxName'; zdBills.Columns[0].Width := 58; zdBills.Columns[1].Width := 0; zdBills.Columns[4].Width := 50; zdBills.Columns[5].Width := 50; zdBills.Columns[6].Width := 0; zdBills.Columns[7].Width := 0; zdBills.Columns[0].Title.Caption := '清单编号' end; zgBills.CurCol := 3; cdsRations.EmptyDataSet; cdsRations.IndexFieldNames := 'Code;BillsItemID;SerialNo'; cdsBills.EmptyDataSet; // cdsSearch.IndexDefs.Add('idxB_Code', 'B_Code', []); // to do(s): cdsSearch.CloneCursor(AProject.Bills.cdsOrgBills, True); // cdsSearch.IndexName := 'idxB_Code'; sdvSearch.DataSet := AProject.Bills.BillsDM.sdsBills; sdvSearch.IndexName := 'idxB_Code'; cdsGLJ.IndexDefs.Clear; cdsGLJ.AddIndex('idxCode', 'Code', []); cdsGLJ.IndexName := 'idxCode'; sdvBookMark.DataSet := AProject.Bills.BillsDM.sdsBills; sdvBookMark.Active := True; SearchRecords(Trim(edtSearch.Text)); zgBookmark.Height := zgBookmark.Parent.Height - Splitter2.Height - 250; if AProject.ProjType in [ptBudget, ptBudgetEstimate, ptProposalEstimate, ptFeasibilityEstimate] then begin rbBillCode.Caption := '分项编号'; rbBillName.Caption := '分项名称'; end else begin rbBillCode.Caption := '清单编号'; rbBillName.Caption := '清单名称'; end; if AProject.IsGD3J then begin sgdBookmark.Columns[1].Visible := True; sgdBookmark.Columns[1].Title.Caption := '清单子目号'; end else begin //sgdBookmark.Columns[1].Title.Caption := '分项编号'; sgdBookmark.Columns[1].Visible := False; end; aqBookMarkColor.Connection := AProject.DM.acnProject; aqBookMarkColor.Open; pnlDefaultColor.Color := AProject.BookMarkColor; // lblDefaultColor.Color := AProject.BookMarkColor; aqSQL.Connection := AProject.DM.acnProject; end; procedure TfrmSearchAndReplace.cdsRationsTypeGetText( Sender: TField; var Text: String; DisplayText: Boolean); begin if DisplayText then begin if Sender.AsInteger = 0 then Text := 'False' else if Sender.AsInteger = 1 then Text := 'True'; end; end; procedure TfrmSearchAndReplace.LocateCurBills; var ProjForm: TScProjForm; vNode, RNode: TsdIDTreeNode; begin ProjForm := TScProjForm(Application.MainForm.ActiveMDIChild); // 清单 if pcSAndR.ActivePageIndex = 0 then begin if cdsBills.Active and (cdsBills.RecordCount > 0) then begin vNode := FBillsTree[cdsBillsID.Value]; if vNode <> nil then begin if not vNode.Expanded then vNode.Expanded := True; vNode.LocateInControl; end else begin if FProject.IsBills then MessageHint(0, '无法定位，清单可能已被删除。') else MessageHint(0, '无法定位，分项可能已被删除。'); end; end; end // 定额 else if pcSAndR.ActivePageIndex = 1 then begin // 定位清单 if cdsRations.Active and (cdsRations.RecordCount > 0) then begin vNode := FBillsTree.FindNode(cdsRationsBillsItemID.Value); if vNode <> nil then begin if not vNode.Expanded then vNode.Expanded := True; vNode.LocateInControl; end else begin if FProject.IsBills then MessageHint(0, '无法定位，该定额所在的清单可能已被删除。') else MessageHint(0, '无法定位，该定额所在的分项可能已被删除。'); Exit; end; end; // 定位定额 if cdsRationsType.AsInteger = 0 then begin ProjForm.tbtnAll.Click; ProjForm.tbtnAll.Down := True; FProject.Rations.LocateRation(cdsRationsID.AsInteger); end // 定位数量单价 else if cdsRationsType.AsInteger = 1 then begin // ProjForm.BillsSubItemView.PageControl.ActivePageIndex := 1; if not cdsRationsIsMeCalc.AsBoolean then begin ProjForm.tbtnAll.Click; ProjForm.tbtnAll.Down := True; FProject.Rations.LocateRation(cdsRationsID.AsInteger); (* if ConfigInfo.RationDisplayMode = 0 then begin ProjForm.btnRation.Click; ProjForm.btnRation.Down := True; FProject.Rations.LocateRation(cdsRationsID.AsInteger); end else begin ProjForm.btnCountPrice.Click; ProjForm.btnCountPrice.Down := True; FProject.Rations.LocateCountPrice(cdsRationsID.AsInteger); end; *) end else begin ProjForm.btnME.Click; ProjForm.btnME.Down := True; FProject.Rations.LocateDevices(cdsRationsID.AsInteger); end end; end // 工料机 else if pcSAndR.ActivePageIndex = 2 then begin if sdvRations2.Active and (sdvRations2.RecordCount > 0) then begin RNode := stdRations2.IDTree.Selected; if RNode <> nil then begin // 定额通过SBillsItemID定位，清单直接通过ID定位 if RNode.Rec.ValueByName('IsRation').AsBoolean then vNode := FBillsTree.FindNode(RNode.Rec.ValueByName(SBillsItemID).AsInteger) else vNode := FBillsTree.FindNode(RNode.ID); if vNode <> nil then begin if not vNode.Expanded then vNode.Expanded := True; vNode.LocateInControl; end else begin if FProject.IsBills then MessageHint(0, '无法定位，该工料机所在的清单可能已被删除。') else MessageHint(0, '无法定位，该工料机所在的分项可能已被删除。'); Exit; end; // 是定额则定位定额 if RNode.Rec.ValueByName('IsRation').AsBoolean then begin ProjForm.BillsSubItemView.PageControl.ActivePageIndex := 0; ProjForm.btnRation.Down := True; FProject.Rations.LocateRation(RNode.Rec.ValueByName(SRationID).AsInteger); end; end; end; end // 书签 else if pcSAndR.ActivePageIndex = 3 then begin // 定位清单 if sdvBookMark.Active and (sdvBookMark.RecordCount > 0) then begin vNode := FBillsTree.FindNode(TScBillsRecord(sdvBookMark.Current).ID.AsInteger); if vNode <> nil then begin if not vNode.Expanded then vNode.Expanded := True; vNode.LocateInControl; end else begin if FProject.IsBills then MessageHint(0, '无法定位，该书签对应的清单可能已被删除。') else MessageHint(0, '无法定位，该书签对应的分项可能已被删除。'); Exit; end; end; end; end; procedure TfrmSearchAndReplace.zgRationsMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if ssDouble in Shift then LocateCurBills; end; procedure TfrmSearchAndReplace.SearchRations(AValue: String; ASearchKind: TSearchKind); var I: Integer; sdRation: TScRationRecord; sFiledValue: String; vGLJ: TScGLJRecord; fSumT, fSumQ: Double; begin try Screen.Cursor := crHourGlass; cdsRations.DisableControls; fSumT := 0; fSumQ := 0; for I := 0 to FProject.Rations.sdsRations.RecordCount - 1 do begin sdRation := TScRationRecord(FProject.Rations.sdsRations[I]); // 分摊的定额过滤掉 if sdRation.FTItemFlag.AsInteger = 1 then Continue; if (rbRationCode.Checked or rbRationName.Checked) and (sdRation.RationType.AsInteger <> 0) then Continue; if rbCountPrice.Checked and ((sdRation.RationType.AsInteger <> 1) or sdRation.IsMECalc.AsBoolean) then Continue; if rbDevices.Checked and ((sdRation.RationType.AsInteger <> 1) or (not sdRation.IsMECalc.AsBoolean)) then Continue; case ASearchKind of skCode: sFiledValue := sdRation.Code.AsString; skName: sFiledValue := sdRation.Name.AsString; end; if ((AValue = '') or (Pos(AValue, sFiledValue) > 0)) and (sdRation.Quantity.AsFloat <> 0) then begin cdsRations.Append; cdsRationsID.AsInteger := sdRation.ID.AsInteger; cdsRationsLibID.AsInteger := sdRation.LibID.AsInteger; cdsRationsCode.AsString := sdRation.Code.AsString; cdsRationsBillsItemID.AsInteger := sdRation.BillsItemID.AsInteger; cdsRationsName.AsString := sdRation.Name.AsString; cdsRationsMaskName.AsString := sdRation.MaskName.AsString; cdsRationsUnit.AsString := ConvertUnitStr(sdRation.Units.AsString); cdsRationsQuantity.AsFloat := sdRation.Quantity.AsFloat; if rbCountPrice.Checked or rbDevices.Checked then cdsRationsUnitPrice.AsFloat := sdRation.UnitDirectFee.AsFloat else cdsRationsUnitPrice.AsFloat := sdRation.BuildingUnitPrice.AsFloat; cdsRationsType.AsInteger := sdRation.RationType.AsInteger; cdsRationsCodeForReport.AsString := sdRation.CodeForReport.AsString; cdsRationsSerialNo.AsInteger := sdRation.SerialNo.AsInteger; cdsRationsIsMeCalc.AsBoolean := sdRation.IsMECalc.AsBoolean; cdsRationsUnitFee.AsFloat := sdRation.UnitDirectFee.AsFloat; cdsRationsTotalFee.AsFloat := sdRation.BuildingFee.AsFloat; cdsRationsAdjustState.AsString := sdRation.AdjustState.AsString; if (sdRation.RationType.AsInteger = 0) then // 定额 begin vGLJ := FProject.GLJ.FindGLJByRationIDAndGLJCode(sdRation.ID.AsInteger, SJiJiaCode); if vGLJ <> nil then cdsRationsBasePrice.AsFloat := vGLJ.Quantity.AsFloat; end else begin if sdRation.IsMECalc.AsBoolean then cdsRationsBasePrice.AsFloat := sdRation.UnitDirectFee.AsFloat; end; fSumT := fSumT + sdRation.BuildingFee.AsFloat; fSumQ := fSumQ + sdRation.Quantity.AsFloat; end; end; cdsRations.First; // if (rbCountPrice.Checked or rbDevices.Checked) then // begin // pnlSumRation.Visible := True; // pnlSumRation.Caption := Format('【金额合计】%g', [fSumT]); // end // else // begin // pnlSumRation.Visible := False; // end; pnlSumRation.Caption := Format('【金额合计】%g 【数量合计】%g', [fSumT, fSumQ]); finally cdsRations.EnableControls; Screen.Cursor := crDefault; end; end; procedure TfrmSearchAndReplace.SearchBills(AValue: String; ASearchKind: TSearchKind; OnlyFirstParts: Boolean); var ACDS, cdsFind: TClientDataSet; sFiledValue: String; vTree: TScBillsTree; Item2Idx, Item3Idx, TreeMaxIdx, i, curIdx: Integer; bIsME: Boolean; fSumT, fSumQ: Double; begin try Screen.Cursor := crHourGlass; cdsBills.DisableControls; vTree := FProject.Bills.BillsTree; Item2Idx := vTree[2].MajorIndex; Item3Idx := vTree[3].MajorIndex; if not Assigned(vTree[6]) then TreeMaxIdx := vTree[10].MajorIndex else TreeMaxIdx := vTree[6].MajorIndex; fSumT := 0; fSumQ := 0; for i := 0 to TreeMaxIdx do begin case ASearchKind of skCode: sFiledValue := vTree.Items[i].Code; {$IFDEF _ScGuangDong} skB_Code: sFiledValue := vTree.Items[i].B_Code; {$ENDIF} skName: sFiledValue := vTree.Items[i].Name; end; if (AValue = '') or (Pos(AValue, sFiledValue) > 0) then begin if FProject.IsGuangDong then if (ASearchKind = skB_Code) then begin if vTree.Items[i].B_Code = '' then Continue; end; // 只显示机电：用Filter后重新指定索引会提示“operation not permitted” // 所以不用Filter，直接在这里处理 curIdx := vTree.Items[i].MajorIndex; bIsME := (curIdx > Item2Idx) and (curIdx < Item3Idx); if (not bIsME) and chkOnlyME.Checked then Continue; cdsBills.Append; cdsBillsIsME.AsBoolean := bIsME; cdsBillsSerialNo.AsInteger := curIdx; cdsBillsID.AsInteger:= vTree.Items[i].ID; cdsBillsCode.AsString := vTree.Items[i].Code; if FProject.IsGuangDong then cdsBillsB_Code.AsString := vTree.Items[i].Rec.B_Code.AsString; cdsBillsName.AsString := vTree.Items[i].Rec.Name.AsString; cdsBillsUnits.AsString := vTree.Items[i].Rec.Units.AsString; cdsBillsQuantity.AsFloat := vTree.Items[i].Rec.Quantity.AsFloat; cdsBillsUnitPrice.AsFloat := vTree.Items[i].Rec.UnitPrice.AsFloat; cdsBillsDesignQuantity.AsFloat := vTree.Items[i].Rec.DesignQuantity.AsFloat; cdsBillsDesignPrice.AsFloat := vTree.Items[i].Rec.DesignPrice.AsFloat; cdsBillsTotalPrice.AsFloat := vTree.Items[i].Rec.TotalPrice.AsFloat; cdsBills.Post; fSumT := fSumT + vTree.Items[i].Rec.TotalPrice.AsFloat; fSumQ := fSumQ + vTree.Items[i].Rec.Quantity.AsFloat; end; end; finally cdsBills.EnableControls; pnlSumBill.Caption := Format('【金额合计】%g 【数量合计】%g', [fSumT, fSumQ]); Screen.Cursor := crDefault; end; end; procedure TfrmSearchAndReplace.zgBillsMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if ssDouble in Shift then LocateCurBills; end; procedure TfrmSearchAndReplace.btnReplaceClick(Sender: TObject); var s1,s2, newName: string; sdRation: TScRationRecord; begin if not (rbBillName.Checked or rbRationName.Checked) then Exit; s1 := trim(edtSearch.Text); s2 := trim(edtReplace.Text); if (s1 = '') or (s2 = '') then exit; if ((not cdsBills.Active) or (cdsBills.RecordCount < 1)) and ((not cdsRations.Active) or (cdsRations.RecordCount < 1)) then exit; if not MessageQuest('确定要将查询结果中所有包含的 “'+ s1 + '” 替换成 “' + s2 + '” 吗？') then Exit; Screen.Cursor := crHourGlass; try if rbBillName.Checked then begin FProject.Bills.BillsDM.sdsBills.BeginUpdate; try cdsBills.First; while not cdsBills.Eof do begin newName := StringReplace(cdsBillsName.AsString, s1, s2, [rfReplaceAll,rfIgnoreCase]); FProject.Bills.BillsTree[cdsBillsID.AsInteger].Rec.Name.AsString := newName; cdsBills.Next; end; finally FProject.Bills.BillsDM.sdsBills.EndUpdate; end; cdsBills.EmptyDataSet; SearchBills(s2, skName, True); end else if rbRationName.Checked then begin cdsRations.First; while not cdsRations.Eof do begin newName := StringReplace(cdsRationsName.AsString, s1, s2, [rfReplaceAll,rfIgnoreCase]); sdRation := FProject.Rations.FindRation(cdsRationsID.AsInteger); sdRation.Name.AsString := newName; cdsRations.Next; end; cdsRations.EmptyDataSet; SearchRations(s2, skName); end; finally Screen.Cursor := crDefault; end; end; procedure QuickSortChildren(AParent: TsdIDTreeNode); function CompareNode(ANode1, ANode2: TsdIDTreeNode): Integer; var iSN1, iSN2: Integer; begin iSN1 := ANode1.Rec.ValueByName(SSerialNo).AsInteger; iSN2 := ANode2.Rec.ValueByName(SSerialNo).AsInteger; if iSN1 > iSN2 then Result := 1 else if iSN1 < iSN2 then Result := -1 else Result := 0; end; procedure QuickSort(iLo, iHi: Integer); var Lo, Hi: Integer; Mid: TsdIDTreeNode; begin Lo := iLo; Hi := iHi; Mid := AParent.ChildNodes[(iLo + iHi) div 2]; repeat while CompareNode(AParent.ChildNodes[Lo], Mid) < 0 do Lo := Lo + 1; while CompareNode(AParent.ChildNodes[Hi], Mid) > 0 do Hi := Hi - 1; if Lo <= Hi then begin if Lo < Hi then begin AParent.Owner.Exchange(AParent.ChildNodes[Lo], AParent.ChildNodes[Hi]); end; Lo := Lo + 1; Hi := Hi - 1; end; until Lo > Hi; if Hi > iLo then QuickSort(iLo, Hi); if Lo < iHi then QuickSort(Lo, iHi); end; begin if AParent.ChildCount > 1 then QuickSort(0, AParent.ChildCount - 1); end; procedure TfrmSearchAndReplace.SearchRationsByGLJ(AGLJID: Integer); var Tree: TsdIDTree; lstBillsID: TList; function AddNode(ABillsItem: TScBillsItem): TsdIDTreeNode; var Node, ParentNode: TsdIDTreeNode; BillsNode, ParentBills, NextBills: TScBillsItem; I, iParentID, iNextID: Integer; strCode: string; begin Result := nil; // 先找节点是否存在 Node := Tree.FindNode(ABillsItem.ID); if Node <> nil then begin Result := Node; Exit; end; // 递归 if (ABillsItem <> nil) and (ABillsItem.Parent <> nil) then ParentNode := AddNode(TScBillsItem(ABillsItem.Parent)); // 确定后兄弟 ParentBills := TScBillsItem(ABillsItem.Parent); NextBills := nil; BillsNode := TScBillsItem(ABillsItem.NextSibling); while BillsNode <> nil do begin if ((not BillsNode.IsLeaf) or (lstBillsID.IndexOf(Pointer(BillsNode.ID)) >= 0)) and (Tree.FindNode(BillsNode.ID) <> nil) then begin NextBills := BillsNode; Break; end; BillsNode := TScBillsItem(BillsNode.NextSibling); end; // 添加 if ParentBills <> nil then iParentID := ParentBills.ID else iParentID := -1; if NextBills <> nil then iNextID := NextBills.ID else iNextID := -1; Result := Tree.Add(ABillsItem.ID, iParentID, iNextID, True); try if ABillsItem.Rec.B_Code.AsString <> '' then strCode := ABillsItem.Rec.B_Code.AsString else strCode := ABillsItem.Rec.Code.AsString; Result.Rec.ValueByName(SCode).AsString := strCode; Result.Rec.ValueByName(SName).AsString := ABillsItem.Rec.Name.AsString; Result.Rec.ValueByName(SUnitPrice).AsCurrency := ABillsItem.Rec.UnitPrice.AsCurrency; Result.Rec.ValueByName('IsRation').AsBoolean := False; finally Result.Rec.EndUpdate; end; end; function AddParents(ABillsItemID: Integer): TsdIDTreeNode; var BillsItem: TScBillsItem; begin Result := Tree.FindNode(ABillsItemID); if Result <> nil then Exit; BillsItem := FBillsTree.BillsItem[ABillsItemID]; Result := AddNode(BillsItem); end; procedure ResortRations(ANode: TsdIDTreeNode); begin if ANode = nil then Exit; if ANode.ChildCount > 0 then begin if ANode.FirstChild.Rec.ValueByName('IsRation').AsBoolean then QuickSortChildren(ANode) else ResortRations(ANode.FirstChild); end; ResortRations(ANode.NextSibling); end; var I, iLength: Integer; Node, ParentNode: TsdIDTreeNode; Rec: TsdDataRecord; sdRation: TScRationRecord; BillsRec: TScBillsRecord; RationIDsArray: TRationIDsArray; RCountPriceIDsArray: TRationIDsArray; lstRations: TList; begin Screen.Cursor := crHourGlass; try lstBillsID := TList.Create; lstRations := TList.Create; Tree := stdRations2.IDTree; Tree.AutoCreateKeyID := False; Tree.DeleteAll; // 通过工料机ID获取定额的ID数组 RationIDsArray := FProject.GLJ.GetRationIDsByGLJID(AGLJID); // 通过工料机ID获取数量单价的ID数组 RCountPriceIDsArray := FProject.Rations.GetCountPriceIDsByGLJID(AGLJID); // 合并为一个数组 iLength := Length(RationIDsArray); SetLength(RationIDsArray, iLength + Length(RCountPriceIDsArray)); CopyMemory(@RationIDsArray[iLength], @RCountPriceIDsArray[0], Length(RCountPriceIDsArray)); // 缓存清单ID for I := Low(RationIDsArray) to High(RationIDsArray) do begin sdRation := FProject.Rations.FindRation(RationIDsArray[I]); lstRations.Add(sdRation); lstBillsID.Add(Pointer(sdRation.BillsItemID.AsInteger)); end; // 遍历定额 for I := 0 to lstRations.Count - 1 do begin sdRation := TScRationRecord(lstRations[I]); if sdRation.FTItemFlag.AsInteger = 1 then Continue; // 添加所有清单父项 ParentNode := AddParents(sdRation.BillsItemID.AsInteger); Node := Tree.Add(10000000 + sdRation.ID.AsInteger, ParentNode.ID, -1, True); Rec := Node.Rec; try Rec.ValueByName(SCode).AsString := sdRation.Code.AsString; Rec.ValueByName(SName).AsString := sdRation.Name.AsString; Rec.ValueByName(SBillsItemID).AsInteger := sdRation.BillsItemID.AsInteger; Rec.ValueByName(SUnitPrice).AsCurrency := sdRation.BuildingUnitPrice.AsCurrency; Rec.ValueByName('IsRation').AsBoolean := True; Rec.ValueByName(SRationID).AsInteger := sdRation.ID.AsInteger; Rec.ValueByName(SSerialNo).AsInteger := sdRation.SerialNo.AsInteger; finally Rec.EndUpdate; end; end; ResortRations(Tree.FirstNode); finally Screen.Cursor := crDefault; lstBillsID.Free; lstRations.Free; end; end; procedure TfrmSearchAndReplace.zgRationsShowHint(var HintStr: String; var CanShow: Boolean; var HintInfo: THintInfo; const ACoord: TPoint); var iActiveRec: Integer; sHint: string; begin iActiveRec := ACoord.Y - zgRations.FixedRowCount; begin if ACoord.X = 1 then sHint := '双击定位'; CanShow := True; HintInfo.HintMaxWidth := 300; HintStr := sHint; end; if RADM = nil then Exit; if zdRations.ChangeActiveRecord(iActiveRec, iActiveRec) then try if ACoord.X = 2 then begin if zdRations.DataSet.FieldByName('Type').AsInteger = 0 then sHint := FRADM.LookupRationGLJ(zdRations.DataSet.FieldByName('Code').AsString) // 数量单价类 else sHint := '数量单价类'; HintInfo.HideTimeout := 30000; if sHint <> '' then begin CanShow := True; HintInfo.HintMaxWidth := 300; HintStr := sHint; end; end; finally zdRations.ChangeActiveRecord(iActiveRec, iActiveRec); end; end; procedure TfrmSearchAndReplace.zgRations2ShowHint(var HintStr: String; var CanShow: Boolean; var HintInfo: THintInfo; const ACoord: TPoint); var iActiveRec: Integer; sHint: string; Node: TsdIDTreeNode; begin iActiveRec := ACoord.Y - zgRations2.FixedRowCount; begin if ACoord.X = 1 then sHint := '双击定位'; CanShow := True; HintInfo.HintMaxWidth := 300; HintStr := sHint; end; if RADM = nil then Exit; Node := stdRations2.IDTree.Items[iActiveRec]; if Node <> nil then if ACoord.X = 2 then begin // Modified by GiLi 2012-3-15 19:14:48 // 犹豫数量单价的定额号不是标准的定额编号，而是等于工料机的编号 // 所以，Hint不能用原来的，不然会弹出提示框“定额号需大于或等于8位数字。请重新输入” if Node.Rec.ValueByName('IsRation').AsBoolean then begin if 0 <> CompareText(cdsGLJCode.AsString, Node.Rec.ValueByName(SCode).AsString) then begin sHint := FRADM.LookupRationGLJ(Node.Rec.ValueByName(SCode).AsString); HintInfo.HideTimeout := 30000; if sHint <> '' then begin CanShow := True; HintInfo.HintMaxWidth := 300; HintStr := sHint; end; end else begin // Modified by GiLi 2012-3-15 19:41:29 HintStr := '编号: ' + cdsGLJCode.AsString + #13#10 + '名称: ' + cdsGLJName.AsString + #13#10 + '规格: ' + cdsGLJSpecs.AsString + #13#10 + '单位: ' + cdsGLJUnit.AsString + #13#10 + '单价: ' + FloatToStr(ScRoundTo(cdsGLJBudgetPrice.AsFloat, -2)); end; end; end; end; procedure TfrmSearchAndReplace.SearchBillsByB_Code(AValue: String); var vItem: TScBillsItem; SNo2, i: Integer; procedure addBill; begin cdsBills.Append; if vItem.Rec.SerialNo.AsInteger > SNo2 then cdsBillsIsME.AsBoolean := True else cdsBillsIsME.AsBoolean := False; with vItem.Rec do begin cdsBillsSerialNo.AsVariant := SerialNo.AsVariant; cdsBillsID.AsInteger := ID.AsInteger; cdsBillsB_Code.AsVariant := B_Code.AsVariant; cdsBillsName.AsVariant := Name.AsVariant; cdsBillsQuantity.AsVariant := Quantity.AsVariant; cdsBillsUnitPrice.AsVariant := UnitPrice.AsVariant; cdsBillsTotalPrice.AsVariant := TotalPrice.AsVariant; end; {// Chenshilong, 2010-3-28 12:31:25 以下这段严重影响效率，先屏蔽。 while (vBillItem <> nil) and (vBillItem.Code = '') do vBillItem := TScBillsItem(vBillItem.Parent); if vBillItem <> nil then cdsBills2Code.AsString := vBillItem.Code; } cdsBills.Post; end; begin SNo2 := TScBillsItem(FProject.Bills.BillsTree[2]).Rec.SerialNo.AsInteger; for i := 0 to FProject.Bills.BillsTree.Count - 1 do begin vItem := FProject.Bills.BillsTree.Items[i]; if vItem.B_Code <> '' then begin if ((AValue = '') or (Pos(AValue, vItem.B_Code) = 1)) and (vItem.Rec.IsLeaf.AsBoolean = True) then addBill; end; end; end; procedure TfrmSearchAndReplace.DoOnBillsScroll(DataSet: TDataSet); begin if FProject.IsGuangDong then begin if not chkLocateFirstAppear.Checked then Exit; if FBillsTree.Selected = nil then Exit; if TScBillsItem(FBillsTree.Selected).B_Code <> '' then cdsBills.Locate('B_Code', TScBillsItem(FBillsTree.Selected).B_Code, []); end; end; procedure TfrmSearchAndReplace.btnSearchRationClick(Sender: TObject); begin cdsRations.EmptyDataSet; if rbRationName.Checked then SearchRations(Trim(edtSearch.Text), skName) else if rbRationCode.Checked then SearchRations(Trim(edtSearch.Text), skCode); end; procedure TfrmSearchAndReplace.edtSearchKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if key = VK_Return then btnSearch.Click; end; procedure TfrmSearchAndReplace.btnSearchClick(Sender: TObject); begin SearchRecords(Trim(edtSearch.Text)); end; procedure TfrmSearchAndReplace.SearchGLJs(AValue: String; ASearchKind: TSearchKind); var I: Integer; Rec: TScProjectGLJRecord; sFiledValue: string; evt: TDataSetNotifyEvent; begin evt := cdsGLJ.AfterScroll; cdsGLJ.AfterScroll := nil; cdsGLJ.DisableControls; Screen.Cursor := crHourGlass; try for I := 0 to FProject.ProjectGLJ.sdsProjectGLJ.RecordCount - 1 do begin Rec := FProject.ProjectGLJ.GLJ[I]; case ASearchKind of skCode: sFiledValue := Rec.Code.AsString; skName: sFiledValue := Rec.Name.AsString; end; if (AValue = '') or (Pos(AValue, sFiledValue) > 0) then begin cdsGLJ.Append; cdsGLJCode.AsString := Rec.Code.AsString; cdsGLJName.AsString := Rec.Name.AsString; cdsGLJID.AsInteger := Rec.ID.AsInteger; cdsGLJLibID.AsInteger := Rec.LibID.AsInteger; cdsGLJUnit.AsString := ConvertUnitStr(Rec.Units.AsString); cdsGLJSpecs.AsString := Rec.Specs.AsString; cdsGLJBudgetPrice.AsFloat:= Rec.BudgetPrice.AsFloat; cdsGLJ.Post; end; end; cdsGLJ.First; if (not cdsGLJ.Active) or (cdsGLJ.RecordCount < 1) then begin stdRations2.IDTree.DeleteAll; Exit; end; SearchRationsByGLJ(cdsGLJID.AsInteger); finally cdsGLJ.AfterScroll := evt; cdsGLJ.EnableControls; Screen.Cursor := crDefault; end; end; procedure TfrmSearchAndReplace.zgBillsShowHint(var HintStr: String; var CanShow: Boolean; var HintInfo: THintInfo; const ACoord: TPoint); var i: Integer; begin if FProject.IsGuangDong then i := 2 else i := 1; if ACoord.x = i then begin CanShow := True; HintInfo.HintMaxWidth := 300; HintStr := '双击定位'; end; end; procedure TfrmSearchAndReplace.cdsGLJAfterScroll(DataSet: TDataSet); begin if not cdsGLJ.Active then Exit; if cdsGLJ.RecordCount < 1 then Exit; sdsRations2.DeleteAll; SearchRationsByGLJ(cdsGLJID.AsInteger); end; procedure TfrmSearchAndReplace.SetProject(const Value: TScProject); begin FProject := Value; FRADM.InitData(FProject.RationLibs); Init(Value); end; procedure TfrmSearchAndReplace.RadioButtonCheck; begin if rbBillB_Code.Checked then begin pcSAndR.ActivePage := PageBill; ReplaceEnable(False); AboveAverageEnable(True); end else if rbBillCode.Checked then begin pcSAndR.ActivePage := PageBill; ReplaceEnable(False); AboveAverageEnable(True); end else if rbBillName.Checked then begin pcSAndR.ActivePage := PageBill; // ReplaceEnable(True); if FProject.IsGuangDong then // AboveAverageEnable(False) AboveAverageEnable(True) else if FProject.ProjType = ptBudget then AboveAverageEnable(True); end else if rbRationCode.Checked then begin pcSAndR.ActivePage := PageRation; ReplaceEnable(False); AboveAverageEnable(False); end else if rbRationName.Checked or rbCountPrice.Checked or rbDevices.Checked then begin pcSAndR.ActivePage := PageRation; // ReplaceEnable(True); AboveAverageEnable(False); end else if rbGLJCode.Checked then begin pcSAndR.ActivePage := PageGLJ; ReplaceEnable(False); AboveAverageEnable(False); end else if rbGLJName.Checked then begin pcSAndR.ActivePage := PageGLJ; ReplaceEnable(False); AboveAverageEnable(False); end else if rbBookmark.Checked then begin pcSAndR.ActivePage := PageBookmark; ReplaceEnable(False); AboveAverageEnable(False); RefreshBookmarkStr(sdvBookMark.Current); end; SearchRecords(edtSearch.Text); if edtSearch.CanFocus then edtSearch.SetFocus; end; procedure TfrmSearchAndReplace.rbBillB_CodeClick(Sender: TObject); begin RadioButtonCheck; end; procedure TfrmSearchAndReplace.rbBillNameClick(Sender: TObject); begin RadioButtonCheck; end; procedure TfrmSearchAndReplace.rbRationCodeClick(Sender: TObject); begin RadioButtonCheck; end; procedure TfrmSearchAndReplace.rbRationNameClick(Sender: TObject); begin RadioButtonCheck; end; procedure TfrmSearchAndReplace.rbGLJCodeClick(Sender: TObject); begin RadioButtonCheck; end; procedure TfrmSearchAndReplace.rbGLJNameClick(Sender: TObject); begin RadioButtonCheck; end; constructor TfrmSearchAndReplace.Create(AOwner: TComponent); begin inherited; FRADM := TRationAssistantDM.Create(nil); pnlColorSet.Visible := btnColorView.Down; end; destructor TfrmSearchAndReplace.Destroy; begin FRADM.Free; AggUnitPrice.Free; inherited; end; procedure TfrmSearchAndReplace.ReplaceEnable(AEnable: Boolean); begin pnReplace.Visible := AEnable; end; procedure TfrmSearchAndReplace.SearchRecords(SearchText: string); begin if rbBillName.Checked then begin cdsBills.EmptyDataSet; if Project.IsGuangDong then cdsBills.IndexName := 'IdxNameBCode' else cdsBills.IndexName := 'IdxName'; SearchBills(SearchText, skName, True); end else if rbBillB_Code.Checked then begin cdsBills.EmptyDataSet; cdsBills.IndexName := 'IdxBCodeCode'; SearchBills(SearchText, skB_Code); end else if rbBillCode.Checked then begin cdsBills.EmptyDataSet; cdsBills.IndexName := 'IdxCode'; SearchBills(SearchText, skCode); end else if rbRationName.Checked or rbCountPrice.Checked or rbDevices.Checked then begin cdsRations.EmptyDataSet; SearchRations(SearchText, skName); end else if rbRationCode.Checked then begin cdsRations.EmptyDataSet; SearchRations(SearchText, skCode); end else if rbGLJName.Checked then begin cdsGLJ.EmptyDataSet; sdsRations2.DeleteAll; SearchGLJs(SearchText, skName); end else if rbGLJCode.Checked then begin cdsGLJ.EmptyDataSet; sdsRations2.DeleteAll; SearchGLJs(SearchText, skCode); end else if rbBookmark.Checked then begin { if SearchText = '' then begin Exit; end else } SearchBookmarks; end; end; procedure TfrmSearchAndReplace.edtAboveAverageKeyPress(Sender: TObject; var Key: Char); begin if not (Key in ['0'..'9', #8, #13]) then Key := #0; end; procedure TfrmSearchAndReplace.zgBillsCellGetColor(Sender: TObject; ACoord: TPoint; var AColor: TColor); var OldActiveRecd: Integer; dPrice, dAggValue, dPer, dPerValue: Double; begin if chkAboveAverage.Enabled and chkAboveAverage.Checked then begin if edtAboveAverage.Text = '' then Exit; if zdBills.ChangeActiveRecord(ACoord.Y - zgBills.FixedRowCount, OldActiveRecd)then begin { 突出显示业务： 当前单价Pn：P1、P2、P3.... 平均单价P：Pn取平均价。 平均值V：P * x% （x是用户输入的值） 如果当前记录的 |(Pn - P）| > V，则标黄。 } dPer := StrToFloat(edtAboveAverage.Text); if AggUnitPrice.Value = null then dAggValue := 0 else dAggValue := AggUnitPrice.Value; dPerValue := dAggValue * (dPer / 100); if Project.IsBudget then dPrice := zdBills.DataSet.FieldByName('DesignPrice').AsFloat // 概预算 else dPrice := zdBills.DataSet.FieldByName('UnitPrice').AsFloat; try if Abs(dPrice - dAggValue) > dPerValue then AColor := $008EFFFF; finally zdBills.ChangeActiveRecord(OldActiveRecd, OldActiveRecd); end; end; end; end; procedure TfrmSearchAndReplace.edtAboveAverageExit(Sender: TObject); var ini: TIniFile; begin if edtAboveAverage.Modified then begin if Trim(edtAboveAverage.Text) = '' then begin ShowMessage('百分比值必须指定，不能为空!'); edtAboveAverage.SetFocus; edtAboveAverage.SelectAll; Exit; end; try StrToFloat(edtAboveAverage.Text); except ShowMessage('百分比值错误，请修正!'); edtAboveAverage.SetFocus; edtAboveAverage.SelectAll; Exit; end; ini:= TIniFile.Create(ConfigInfo.SystemIniFileName); try ini.WriteString('Options','AboveAveragePercent', edtAboveAverage.Text); finally ini.Free; end; end; end; procedure TfrmSearchAndReplace.AboveAverageEnable(AEnable: Boolean); begin lblAboveAverage.Enabled := AEnable; edtAboveAverage.Enabled := AEnable; chkAboveAverage.Enabled := AEnable; end; procedure TfrmSearchAndReplace.rbBookmarkClick(Sender: TObject); begin RadioButtonCheck; end; procedure TfrmSearchAndReplace.SearchBookmarks; begin sdvBookMark.Filtered := False; sdvBookmark.Filtered := True; sdvBookmark.IndexName := 'idxSerialNo'; //if mmBM.Visible and mmBM.CanFocus then // mmBM.SetFocus; end; procedure TfrmSearchAndReplace.zgBookmarkMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if ssDouble in Shift then LocateCurBills; end; procedure TfrmSearchAndReplace.mmBMExit(Sender: TObject); begin if mmBM.Text = sDefStr then begin Exit; end else begin if sdvBookmark.RecordCount = 0 then begin if FProject.ProjType = ptBudget then MessageHint(0, '无法定位，您未设置分项书签，不能设置批注!') else MessageHint(0, '无法定位，您未设置清单书签，不能设置批注!'); mmBM.Clear; Exit; end; TScBillsRecord(sdvBookMark.Current).BookmarkStr.AsString := mmBM.Text; end; // if sdvBookMark.State in [dsInsert, dsEdit] then // cdsBookmark.Post; end; procedure TfrmSearchAndReplace.mnClearAllBMClick(Sender: TObject); var i: Integer; begin if Application.MessageBox('确定要删除所有书签批注吗？', '询问', MB_YESNO + MB_ICONQUESTION) = ID_No then Exit; while sdvBookMark.RecordCount > 0 do DeleteBookMark(TScBillsRecord(sdvBookMark.Records[0])); end; procedure TfrmSearchAndReplace.mnClearCurBMClick(Sender: TObject); begin if sdvBookMark.RecordCount = 0 then Exit; DeleteBookMark(TScBillsRecord(sdvBookMark.Current)); end; procedure TfrmSearchAndReplace.btnSearchAllClick(Sender: TObject); begin SearchRecords(''); end; procedure TfrmSearchAndReplace.FilterME(AOnlyME: Boolean); begin end; procedure TfrmSearchAndReplace.chkOnlyMEClick(Sender: TObject); begin RadioButtonCheck; end; procedure TfrmSearchAndReplace.chkAboveAverageClick(Sender: TObject); begin RadioButtonCheck; end; procedure TfrmSearchAndReplace.cdsBillsDesignQuantityGetText( Sender: TField; var Text: String; DisplayText: Boolean); begin if Sender.Value = 0 then Text := '' else Text := VarToStr(Sender.Value); end; procedure TfrmSearchAndReplace.mmBMEnter(Sender: TObject); begin if mmBM.Text = sDefStr then //mmBM.SelectAll; mmBM.Text := ''; end; procedure TfrmSearchAndReplace.DeleteBookMark(ARec: TScBillsRecord); begin ARec.BeginUpdate; ARec.BookmarkStr.AsString := ''; ARec.HaveBookmark.AsBoolean := False; ARec.BookmarkColor.AsInteger := 0; ARec.EndUpdate; end; procedure TfrmSearchAndReplace.zgColorCellGetColor(Sender: TObject; ACoord: TPoint; var AColor: TColor); var OldActiveRecd: Integer; vColor: TColor; begin if ACoord.X = 0 then begin if zaColor.ChangeActiveRecord(ACoord.Y - zgColor.FixedRowCount, OldActiveRecd)then begin vColor := TColor(zaColor.DataSet.FieldByName('BMColor').AsInteger); try AColor := vColor; finally zaColor.ChangeActiveRecord(OldActiveRecd, OldActiveRecd); end; end; end; end; procedure TfrmSearchAndReplace.btnColorViewClick(Sender: TObject); begin pnlColorSet.Visible := btnColorView.Down; end; procedure TfrmSearchAndReplace.zgBookmarkCellGetColor(Sender: TObject; ACoord: TPoint; var AColor: TColor); var vRec: TsdDataRecord; vColor: TColor; begin // vColor := sgdBookmark.DataView.Current.ValueByName('BookMarkColor').AsInteger; vRec := sgdBookmark.DataView.Records[ACoord.Y - zgBookmark.FixedRowCount]; if vRec <> nil then begin vColor := vRec.ValueByName('BookMarkColor').AsInteger; if vColor = 0 then // 兼容旧书签颜色 vColor := $00CEE7FF; AColor := vColor; end; end; procedure TfrmSearchAndReplace.zgColorMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if (zgColor.CurCol = 0) and (Button = mbLeft) and (ssDouble in Shift) then begin SetDefaultColor; end; end; procedure TfrmSearchAndReplace.SetDefaultColor; var vColor: TColor; procedure ExecMySQL(ASQL: string); begin aqSQL.Close; aqSQL.SQL.Clear; aqSQL.SQL.Add(ASQL); aqSQL.ExecSQL; end; begin vColor := TColor(zaColor.DataSet.FieldByName('BMColor').AsInteger); pnlDefaultColor.Color := vColor; // lblDefaultColor.Font.Color := vColor; ExecMySQL('Update BookMarkColor set CurColor = Null'); ExecMySQL(Format('Update BookMarkColor set CurColor = 1 where BMColor = %d', [Integer(vColor)])); aqBookMarkColor.Refresh; FProject.BookMarkColor := vColor; end; procedure TfrmSearchAndReplace.zgColorShowHint(var HintStr: String; var CanShow: Boolean; var HintInfo: THintInfo; const ACoord: TPoint); begin if ACoord.X = 0 then begin HintInfo.HintStr := '双击设为默认书签颜色'; CanShow := True; HintInfo.HintMaxWidth := 250; HintInfo.HideTimeout := 30000; end; end; procedure TfrmSearchAndReplace.rbAllClick(Sender: TObject); begin FilterColor; end; procedure TfrmSearchAndReplace.FilterColor; var vColor: Integer; begin // if rbAll.Checked then // begin // cdsBookMark.Filter := 'HaveBookmark'; // cdsBookMark.Filtered := True; // end // else // begin // vColor := aqBookMarkColorBMColor.AsInteger; // cdsBookMark.Filter := Format('HaveBookmark and (BookMarkColor=%d)', [vColor]); // cdsBookMark.Filtered := True; // end; end; procedure TfrmSearchAndReplace.rbOnlyCurClick(Sender: TObject); begin FilterColor; end; procedure TfrmSearchAndReplace.aqBookMarkColorAfterScroll( DataSet: TDataSet); begin FilterColor; end; procedure TfrmSearchAndReplace.sdvBookMarkFilterRecord( ARecord: TsdDataRecord; var Allow: Boolean); begin if TScBillsRecord(ARecord).HaveBookmark.AsBoolean = True then Allow := True else Allow := False; end; procedure TfrmSearchAndReplace.sdvBookMarkCurrentChanged( ARecord: TsdDataRecord); begin RefreshBookmarkStr(ARecord); end; procedure TfrmSearchAndReplace.RefreshBookmarkStr(ARecord: TsdDataRecord); begin if ARecord = nil then begin mmBM.Text := ''; Exit; end; mmBM.Text := TScBillsRecord(ARecord).BookmarkStr.AsString; if mmBM.Text = '' then mmBM.Text := sDefStr; if SameText(mmBM.Text, sDefStr) then mmBM.Font.Color := clGrayText else mmBM.Font.Color := clWindowText; end; procedure TfrmSearchAndReplace.mmBMChange(Sender: TObject); begin if not SameText(mmBM.Text, sDefStr) then mmBM.Font.Color := clWindowText; end; procedure TfrmSearchAndReplace.zgCompareXMLMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); // vGridBill.CurCol := ScMainForm.ActiveChild.BillsView.stdBills.ColumnIndex('DesignQuantity') // 上面这种方式不行，当有字段隐藏时，定位会错位。所以这里写个方法定死。 function GetFocusCol(AFieldName: string): Integer; begin if Project.ProjType = ptBillsBudget then begin if AFieldName = 'Quantity' then Result := 5 else if AFieldName = 'DesignQuantity' then Result := 6 else if AFieldName = 'DesignQuantity2' then Result := 7 end else if Project.ProjType = ptBills then begin if AFieldName = 'Quantity' then Result := 4 else Result := 1 end else if Project.ProjType in [ptBudget, ptBudgetEstimate, ptFeasibilityEstimate, ptProposalEstimate] then begin if AFieldName = 'DesignQuantity' then Result := 4 else if AFieldName = 'DesignQuantity2' then Result := 5 else Result := 1; end; end; var vNode: TScBillsItem; vGridBill, vGridRation: TZJGrid; sValue: string; begin if ssDouble in Shift then begin if cdsCompareXML.RecordCount = 0 then Exit; vNode := FProject.Bills.BillsTree[cdsCompareXMLBillID.AsInteger]; if vNode <> nil then begin // 先定位到清单级别 if not vNode.Expanded then vNode.Expanded := True; vNode.LocateInControl; vGridBill := ScMainForm.ActiveChild.BillsView.zgBills; if SameText(cdsCompareXMLKind.AsString, '分项') or SameText(cdsCompareXMLKind.AsString, '清单') then begin sValue := cdsCompareXMLQuantity.AsString; if Pos('设一', sValue) > 0 then vGridBill.CurCol := GetFocusCol('DesignQuantity') else if Pos('设二', sValue) > 0 then vGridBill.CurCol := GetFocusCol('DesignQuantity2') else if Pos('数量', sValue) > 0 then vGridBill.CurCol := GetFocusCol('Quantity') else vGridBill.CurCol := 1; vGridBill.SetFocus; end else if SameText(cdsCompareXMLKind.AsString, '定额') then begin if cdsCompareXMLRationID.IsNull then MessageHint(0, '定额已被删除，无法定位。当前定位到删除前所在的清单。') else begin FProject.Rations.LocateRation(cdsCompareXMLRationID.AsInteger); vGridBill.CurCol := 1; vGridRation := ScMainForm.ActiveChild.BillsSubItemView.zgRations; vGridRation.CurCol := 6; ScMainForm.ActiveChild.BillsSubItemView.PageControl.ActivePageIndex := 0; vGridRation.SetFocus; end; end else if SameText(cdsCompareXMLKind.AsString, '图纸') then begin FProject.Bills.DrawingQuantityDM.LocateDrawQty(cdsCompareXMLBillID.AsInteger, cdsCompareXMLDrawQtyID.AsInteger); end; end else begin MessageHint(0, '清单已被删除，无法定位。'); end; end; end; procedure TfrmSearchAndReplace.zgCompareXMLCellGetFont(Sender: TObject; ACoord: TPoint; AFont: TFont); var OldActiveRecd: Integer; sValue: string; begin if zaCompareXML.ChangeActiveRecord(ACoord.Y - zgCompareXML.FixedRowCount, OldActiveRecd)then begin sValue := zaCompareXML.DataSet.FieldByName('Operate').AsString; try if (sValue = '增加') then AFont.Color := clBlue else if (sValue = '删除') then AFont.Color := $006060FF; finally zaCompareXML.ChangeActiveRecord(OldActiveRecd, OldActiveRecd); end; end; end; procedure TfrmSearchAndReplace.rbCompareXMLClick(Sender: TObject); begin pcSAndR.ActivePage := PageCompareXML; end; procedure TfrmSearchAndReplace.CompareFromXML; var vPort: TtzslXMLPort; vODlg: TOpenDialog; sPath, sFile: string; begin rbCompareXML.Checked := True; vODlg := TOpenDialog.Create(nil); vODlg.Title := '算量对比'; vODlg.Filter := '算量对比XML文件(*.XML)|*.XML'; try if vODlg.Execute then begin vPort := TtzslXMLPort.Create; try vPort.Project := FProject; vPort.XMLFile := vODlg.FileName; edtFile.Text := vODlg.FileName; vPort.CompareFromXML(cdsCompareXML); finally vPort.Free; end; end else Exit; finally vODlg.Free; end; end; procedure TfrmSearchAndReplace.Search(SearchText: string; AType: TSearchType); begin edtSearch.Text := SearchText; case AType of stBilsCode: rbBillCode.Checked := True; stBillsName: rbBillName.Checked := True; stRationCode: rbRationCode.Checked := True; stRationName: rbRationName.Checked := True; stCountPrice: rbCountPrice.Checked := True; stDevice: rbDevices.Checked := True; stGLJCode: rbGLJCode.Checked := True; stGLJName: rbGLJName.Checked := True; stBookmark: rbBookmark.Checked := True; stCompareXML: begin rbCompareXML.Checked := True; pcSAndR.ActivePage := PageCompareXML; Exit; end; end; RadioButtonCheck; LocateCurBills; zgRations2.SetFocus; end; procedure TfrmSearchAndReplace.zgRations2CellGetColor(Sender: TObject; ACoord: TPoint; var AColor: TColor); var Node: TsdIDTreeNode; begin Node := stdRations2.IDTree.Items[ACoord.Y - zgRations2.FixedRowCount]; if Node <> nil then begin if Node.Rec.ValueByName('IsRation').AsBoolean then AColor := clWhite else AColor := $00F0F0F0; end; end; end.