unit BillsGatherFme; interface uses BillsGatherDm, Globals, sdDB, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ZJGrid, ExtCtrls, ZjGridDBA, ZjGridTreeDBA, ComCtrls, ToolWin, XPMenu, sdGridDBA, JimPages, dxBar, ActnList, CslButton; type TLocateBillsEvent = procedure (AID: Integer) of object; TBillsGatherFrame = class(TFrame) pnlBillsGather: TPanel; zgGclBills: TZJGrid; pnlRelaXmj: TPanel; pnlRelaXmjType: TPanel; tbToolsButton: TToolBar; tobtnDetailGcl: TToolButton; sprBillsGather: TSplitter; xpm: TXPMenu; tobtnDetailDeal: TToolButton; tobtnDetailBGL: TToolButton; jpsRela: TJimPages; jpsRelaDetailGcl: TJimPage; jpsRelaDetailDeal: TJimPage; jpsRelaDetailBGL: TJimPage; zgDetailGcl: TZJGrid; saDetailGcl: TsdGridDBA; saDetailDeal: TsdGridDBA; saDetailBGL: TsdGridDBA; zgDetailBGL: TZJGrid; zgDetailDeal: TZJGrid; saGclBills: TsdGridDBA; dxpmDetailGcl: TdxBarPopupMenu; alBillsGather: TActionList; actnLocateMeasureBills: TAction; actnLocateCompileBills: TAction; pnlTop: TPanel; btnUploadBillsList: TCslButton; procedure zgGclBillsCellGetColor(Sender: TObject; ACoord: TPoint; var AColor: TColor); procedure tobtnDetailGclClick(Sender: TObject); procedure dxpmDetailGclPopup(Sender: TObject); procedure actnLocateMeasureBillsExecute(Sender: TObject); procedure actnLocateMeasureBillsUpdate(Sender: TObject); procedure zgDetailGclMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure actnLocateCompileBillsExecute(Sender: TObject); procedure actnLocateCompileBillsUpdate(Sender: TObject); procedure btnUploadBillsListClick(Sender: TObject); private FBillsGatherData: TBillsGatherData; FShowPhaseData: Boolean; FShowPriceChange: Boolean; FOnLocateMeasureBills: TLocateBillsEvent; FOnLocateCompileBills: TLocateBillsEvent; procedure SetColumnVisible(const AColumn: string; AVisible: Boolean); procedure SetShowPhaseData(const Value: Boolean); procedure SetShowPriceChange(const Value: Boolean); public constructor Create(AProjectFrame: TFrame; ABillsGatherData: TBillsGatherData); destructor Destroy; override; procedure RefreshBills; property ShowPriceChange: Boolean read FShowPriceChange write SetShowPriceChange; property ShowPhaseData: Boolean read FShowPhaseData write SetShowPhaseData; property OnLocateMeasureBills: TLocateBillsEvent read FOnLocateMeasureBills write FOnLocateMeasureBills; property OnLocateCompileBills: TLocateBillsEvent read FOnLocateCompileBills write FOnLocateCompileBills; end; implementation uses ProjectData, UtilMethods, CalcDecimal, MainFrm, PHPWebDm, ConditionalDefines; {$R *.dfm} { TBillsGatherFrame } constructor TBillsGatherFrame.Create(AProjectFrame: TFrame; ABillsGatherData: TBillsGatherData); begin inherited Create(AProjectFrame); FBillsGatherData := ABillsGatherData; saGclBills.DataView := FBillsGatherData.sdvGclBills; saDetailGcl.DataView := FBillsGatherData.sdvDetailGclBills; saDetailDeal.DataView := FBillsGatherData.sdvDetailDealBills; saDetailBGL.DataView := FBillsGatherData.sdvDetailBGLBills; pnlTop.Visible := _IsCloud and (TProjectData(FBillsGatherData.ProjectData).WebChangeSwitch = 1); end; destructor TBillsGatherFrame.Destroy; begin inherited; end; procedure TBillsGatherFrame.RefreshBills; begin FBillsGatherData.RefreshBills; ShowPhaseData := TProjectData(FBillsGatherData.ProjectData).ProjProperties.PhaseCount > 0; end; procedure TBillsGatherFrame.SetColumnVisible(const AColumn: string; AVisible: Boolean); begin if AVisible then saGclBills.Columns.ColumnByName(AColumn).Width := 60 else saGclBills.Columns.ColumnByName(AColumn).Width := 0; end; procedure TBillsGatherFrame.SetShowPhaseData(const Value: Boolean); begin FShowPhaseData := Value; SetColumnVisible('CurDealQuantity', FShowPhaseData); SetColumnVisible('CurDealTotalPrice', FShowPhaseData); SetColumnVisible('CurQcQuantity', FShowPhaseData); SetColumnVisible('CurQcTotalPrice', FShowPhaseData); SetColumnVisible('CurPcQuantity', FShowPhaseData and FShowPriceChange); SetColumnVisible('CurPcTotalPrice', FShowPhaseData and FShowPriceChange); SetColumnVisible('CurGatherQuantity', FShowPhaseData); SetColumnVisible('CurGatherTotalPrice', FShowPhaseData); SetColumnVisible('EndDealQuantity', FShowPhaseData); SetColumnVisible('EndDealTotalPrice', FShowPhaseData); SetColumnVisible('EndQcQuantity', FShowPhaseData); SetColumnVisible('EndQcTotalPrice', FShowPhaseData); SetColumnVisible('EndPcQuantity', FShowPhaseData and FShowPriceChange); SetColumnVisible('EndPcTotalPrice', FShowPhaseData and FShowPriceChange); SetColumnVisible('EndGatherQuantity', FShowPhaseData); SetColumnVisible('EndGatherTotalPrice', FShowPhaseData); end; procedure TBillsGatherFrame.SetShowPriceChange(const Value: Boolean); begin FShowPriceChange := Value; SetColumnVisible('NewPrice', FShowPriceChange); SetColumnVisible('CurPcQuantity', FShowPriceChange and FShowPhaseData); SetColumnVisible('CurPcTotalPrice', FShowPriceChange and FShowPhaseData); SetColumnVisible('EndPcQuantity', FShowPriceChange and FShowPhaseData); SetColumnVisible('EndPcTotalPrice', FShowPriceChange and FShowPhaseData); end; procedure TBillsGatherFrame.zgGclBillsCellGetColor(Sender: TObject; ACoord: TPoint; var AColor: TColor); function CheckSimilarBills(ARow1, ARow2: Integer): Boolean; var bHasSame, bHasDiffer: Boolean; begin bHasSame := SameText(zgGclBills.Cells[1, ARow1].Text, zgGclBills.Cells[1, ARow2].Text); bHasDiffer := (not SameText(zgGclBills.Cells[2, ARow1].Text, zgGclBills.Cells[2, ARow2].Text)) or (not SameText(zgGclBills.Cells[3, ARow1].Text, zgGclBills.Cells[3, ARow2].Text)) or (not SameText(zgGclBills.Cells[4, ARow1].Text, zgGclBills.Cells[4, ARow2].Text)); Result := bHasSame and bHasDiffer; end; function CheckOverRangePercent(AQty, ACompareQty: Double): Boolean; var vQtyDecimal: TDecimal; fCompare: Double; begin vQtyDecimal := TProjectData(FBillsGatherData.ProjectData).ProjProperties.DecimalManager.Common.Quantity; fCompare := vQtyDecimal.RoundTo(AQty * SupportManager.ConfigInfo.OverRangePercent / 100); Result := vQtyDecimal.RoundTo(ACompareQty - fCompare) > vQtyDecimal.CompareValue; end; function CheckOverRange(ARecIndex: Integer): Boolean; var Rec: TsdDataRecord; fQuantity, fDealQuantity, fEndDealQuantity: Double; begin Rec := saGclBills.DataView.Records[ARecIndex]; Result := False; if not Assigned(Rec) then Exit; fDealQuantity := Rec.ValueByName('DealQuantity').AsFloat; fQuantity := Rec.ValueByName('Quantity').AsFloat; fEndDealQuantity := Rec.ValueByName('EndDealQuantity').AsFloat; case SupportManager.ConfigInfo.OverRangeType of 0: Result := CheckOverRangePercent(fQuantity, fEndDealQuantity); 1: Result := CheckOverRangePercent(fDealQuantity, fEndDealQuantity); 2: Result := CheckOverRangePercent(fQuantity, fEndDealQuantity) or CheckOverRangePercent(fDealQuantity, fEndDealQuantity); end; end; var bSimilarBills: Boolean; begin if (ACoord.Y >= zgGclBills.FixedRowCount + 1) and (ACoord.Y < zgGclBills.FixedRowCount + saGclBills.DataView.RecordCount) then begin if ACoord.Y = zgGclBills.FixedRowCount + 1 then bSimilarBills := CheckSimilarBills(ACoord.Y, ACoord.Y + 1) else if ACoord.Y < zgGclBills.FixedRowCount + saGclBills.DataView.RecordCount then bSimilarBills := CheckSimilarBills(ACoord.Y, ACoord.Y - 1) or CheckSimilarBills(ACoord.Y, ACoord.Y + 1) else bSimilarBills := CheckSimilarBills(ACoord.Y, ACoord.Y - 1); {if bSimilarBills then AColor := $00646AFE;} if bSimilarBills then AColor := $0000FFFF; // 黄色 if TProjectData(FBillsGatherData.ProjectData).ProjProperties.ShowOverRange and CheckOverRange(ACoord.Y - zgGclBills.FixedRowCount) then AColor := $00505AFF; // 红色 end; end; procedure TBillsGatherFrame.tobtnDetailGclClick(Sender: TObject); begin jpsRela.ActivePageIndex := TToolButton(Sender).Tag; tobtnDetailGcl.Down := tobtnDetailGcl.Tag = TToolButton(Sender).Tag; tobtnDetailDeal.Down := tobtnDetailDeal.Tag = TToolButton(Sender).Tag; tobtnDetailBGL.Down := tobtnDetailBGL.Tag = TToolButton(Sender).Tag; end; procedure TBillsGatherFrame.dxpmDetailGclPopup(Sender: TObject); begin SetDxBtnAction(actnLocateMeasureBills, MainForm.dxbtnLocateMeasureBills); SetDxBtnAction(actnLocateCompileBills, MainForm.dxbtnLocateCompileBills); end; procedure TBillsGatherFrame.actnLocateMeasureBillsExecute(Sender: TObject); begin if Assigned(saDetailGcl.DataView.Current) and Assigned(FOnLocateMeasureBills) then FOnLocateMeasureBills(saDetailGcl.DataView.Current.ValueByName('RelaBillsID').AsInteger); end; procedure TBillsGatherFrame.actnLocateMeasureBillsUpdate(Sender: TObject); begin TAction(Sender).Enabled := Assigned(saDetailGcl.DataView.Current) and Assigned(FOnLocateMeasureBills); end; procedure TBillsGatherFrame.zgDetailGclMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button = mbRight then dxpmDetailGcl.PopupFromCursorPos; end; procedure TBillsGatherFrame.actnLocateCompileBillsExecute(Sender: TObject); begin if Assigned(saDetailGcl.DataView.Current) and Assigned(FOnLocateCompileBills) then FOnLocateCompileBills(saDetailGcl.DataView.Current.ValueByName('RelaBillsID').AsInteger); end; procedure TBillsGatherFrame.actnLocateCompileBillsUpdate(Sender: TObject); begin TAction(Sender).Enabled := Assigned(saDetailGcl.DataView.Current) and Assigned(FOnLocateCompileBills); end; procedure TBillsGatherFrame.btnUploadBillsListClick(Sender: TObject); var sgsParam: TStrings; sResult: string; begin if saGclBills.DataView.RecordCount = 0 then begin WarningMessage('请先建立台账,再同步清单至云端。'); Exit; end; sgsParam := TStringList.Create; try sgsParam.Add(Format('pmid=%d', [TProjectData(FBillsGatherData.ProjectData).WebID])); //sgsParam.Add(Format('pmid=%d', [1595])); sgsParam.Add(Format('listjson=%s', [FBillsGatherData.GetAllBillsJson])); if PHPWeb.UrlGet(PHPWeb.MeasureURL + 'change/list/create', sgsParam, sResult) = 1 then TipMessage('上传成功。') else WarningMessage(Format('上传数据失败:', [sResult])); finally sgsParam.Free; end; end; end.