Measure/Frames/BillsGatherFme.pas

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;
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
    fCompare: Double;
  begin
    fCompare := TProjectData(FBillsGatherData.ProjectData).ProjProperties.DecimalManager.Common.Quantity.CompareValue;
    if Abs(AQty) > fCompare then
      Result := (ACompareQty / AQty * 100) > SupportManager.ConfigInfo.OverRangePercent
    else
      Result := Abs(ACompareQty) > fCompare;
  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;
    (*
    case SupportManager.ConfigInfo.OverRangeType of
      0: Result := QuantityRoundTo(fEndDealQuantity - fQuantity) > fCompare;
      1: Result := QuantityRoundTo(fEndDealQuantity - fDealQuantity) > fCompare;
      2: Result := (QuantityRoundTo(fEndDealQuantity - fQuantity) > fCompare)
                or (QuantityRoundTo(fEndDealQuantity - fDealQuantity) > fCompare);
    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.