Task #1188 导入签约清单，识别“×”，过滤父项，识别补充清单

Forms/MainFrm.pas

@@ -9,6 +9,7 @@ uses
   AuthFrm,
   // Model & Data & Data Control ...
   ProjectData, SupportUnit, Globals, ZhAPI, ExcelImport, ConditionalDefines,
+  DealBillsExcelImport,
   // Controls & Delphi Default ... (Almost By Add Controls)
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, cxGraphics, JimPages, ComCtrls, dxStatusBar, cxControls, JimTabs,

Units/DealBillsExcelImport.pas

@@ -0,0 +1,288 @@
+unit DealBillsExcelImport;
+
+interface
+
+uses
+  DetailExcelImport, ProjectData, Classes, sdDB;
+
+type
+  TDealBill = class
+  private
+    FB_Code: string;
+    FName: string;
+    FUnits: string;
+    FPrice: Double;
+    FQuantity: Double;
+    FTotalPrice: Double;
+  public
+    property B_Code: string read FB_Code write FB_Code;
+    property Name: string read FName write FName;
+    property Units: string read FUnits write FUnits;
+    property Price: Double read FPrice write FPrice;
+    property Quantity: Double read FQuantity write FQuantity;
+    property TotalPrice: Double read FTotalPrice write FTotalPrice;
+
+    function IsParent(AChild: TDealBill): Boolean;
+  end;
+
+  TDealBillList = class
+  private
+    FList: TList;
+
+    procedure ClearParent(ADealBill: TDealBill);
+
+    function GetCount: Integer;
+    function GetDealBills(AIndex: Integer): TDealBill;
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    procedure AddDealBill(ADealBill: TDealBill);
+
+    property Count: Integer read GetCount;
+    property DealBills[AIndex: Integer]: TDealBill read GetDealBills;
+  end;
+
+  TDealBillsExcelImport = class(TDetailExcelImport)
+  private
+    FDealBills: TDealBillList;
+
+    FB_CodeCol: Integer;
+    FNameCol: Integer;
+    FUnitsCol: Integer;
+    FPriceCol: Integer;
+    FQuantityCol: Integer;
+    FTotalPriceCol: Integer;
+
+    FCurRow: Integer;
+
+    function LoadColumnsFromHead: Boolean;
+    procedure LoadDealBills;
+    procedure WriteDealBills;
+  protected
+    procedure BeginImport; override;
+    procedure EndImport; override;
+
+    procedure Import; override;
+  public
+    constructor Create(AProjectData: TProjectData); override;
+    destructor Destroy; override;
+  end;
+
+implementation
+
+uses DateUtils, DealBillsDm, UtilMethods, SysUtils;
+
+{ TDealBillsExcelImport }
+
+procedure TDealBillsExcelImport.BeginImport;
+begin
+  ProjectData.DealBillsData.DisableEvent;
+  ProjectData.DealBillsData.sddDealBills.BeginUpdate;
+end;
+
+constructor TDealBillsExcelImport.Create(AProjectData: TProjectData);
+begin
+  inherited;
+  FDealBills := TDealBillList.Create;
+end;
+
+destructor TDealBillsExcelImport.Destroy;
+begin
+  FDealBills.Free;
+  inherited;
+end;
+
+procedure TDealBillsExcelImport.EndImport;
+begin
+  ProjectData.DealBillsData.sddDealBills.EndUpdate;
+  ProjectData.DealBillsData.EnableEvent;
+end;
+
+procedure TDealBillsExcelImport.Import;
+begin
+  FCurRow := 1;
+  if LoadColumnsFromHead then
+  begin
+    LoadDealBills;
+    WriteDealBills;
+  end
+  else
+    ErrorMessage('导入的Excel格式有误！');
+end;
+
+function TDealBillsExcelImport.LoadColumnsFromHead: Boolean;
+var
+  iCol: Integer;
+  sColName: string;
+begin
+  Result := False;
+
+  FB_CodeCol := -1;
+  FNameCol := -1;
+  FUnitsCol := -1;
+  FPriceCol := -1;
+  FQuantityCol := -1;
+  FTotalPriceCol := -1;
+
+  while (not Result) and (FCurRow <= Excel.XlsFile.MaxRow) do
+  begin
+    for iCol := 1 to Excel.XlsFile.MaxCol do
+    begin
+      sColName := GetCellValue(Excel.XlsFile, FCurRow, iCol);
+      sColName := StringReplace(sColName, ' ', '', [rfReplaceAll]);
+
+      if SameText(sColName, '清单编号') or SameText(sColName, '子目号') then
+        FB_CodeCol := iCol
+      else if Pos('名称', sColName) > 0 then
+        FNameCol := iCol
+      else if SameText(sColName, '单位') then
+        FUnitsCol := iCol
+      else if Pos('单价', sColName) = 1 then
+        FPriceCol := iCol
+      else if Pos('数量', sColName) > 0 then
+        FQuantityCol := iCol
+      else if SameText(sColName, '金额') or SameText(sColName, '合价') then
+        FTotalPriceCol := iCol;
+    end;
+
+    Result := (FB_CodeCol <> -1) and (FNameCol <> -1) and (FUnitsCol <> -1)
+        and (FPriceCol <> -1) and (FQuantityCol <> -1) and (FTotalPriceCol <> -1);
+    Inc(FCurRow);
+  end;
+end;
+
+procedure TDealBillsExcelImport.LoadDealBills;
+
+  function CheckIsBillsCode(ACode: string): Boolean;
+  const
+    FBillsCodeSet: set of char = ['0'..'9', '-', 'a'..'z', 'A'..'Z'];
+  var
+    I: Integer;
+  begin
+    Result := True;
+    I := 1;
+    while I < Length(ACode) do
+      if ACode[I] in FBillsCodeSet then
+        Inc(I)
+      else
+      begin
+        Result := False;
+        Break;
+      end;
+  end;
+
+  function FilterBillsCode(ACode: string): string;
+  var
+    I: Integer;
+  begin
+    Result := StringReplace(ACode, ' ', '', [rfReplaceAll]);
+    Result := StringReplace(Result, '　', '', [rfReplaceAll]);
+    Result := StringReplace(Result, '补', '', [rfReplaceAll]);
+  end;
+
+var
+  sB_Code, sFilterB_Code: string;
+  vDealBill: TDealBill;
+begin
+  while (FCurRow <= Excel.XlsFile.MaxRow) do
+  begin
+    sB_Code := GetCellTrimStr(Excel.XlsFile, FCurRow, FB_CodeCol);
+    sFilterB_Code := FilterBillsCode(sB_Code);
+    if (sFilterB_Code <> '')then
+    begin
+      if CheckIsBillsCode(sFilterB_Code) then
+      begin
+        vDealBill := TDealBill.Create;
+        vDealBill.B_Code := sB_Code;
+        vDealBill.Name := GetCellTrimStr(Excel.XlsFile, FCurRow, FNameCol);
+        vDealBill.Units := GetCellTrimStr(Excel.XlsFile, FCurRow, FUnitsCol);
+        vDealBill.Price := GetCellFloat(Excel.XlsFile, FCurRow, FPriceCol);
+        vDealBill.Quantity := GetCellFloat(Excel.XlsFile, FCurRow, FQuantityCol);
+        vDealBill.TotalPrice := GetCellFloat(Excel.XlsFile, FCurRow, FTotalPriceCol);
+        FDealBills.AddDealBill(vDealBill);
+      end;
+    end;
+    Inc(FCurRow);
+  end;
+end;
+
+procedure TDealBillsExcelImport.WriteDealBills;
+var
+  i: Integer;
+  vDealBill: TDealBill;
+  Rec: TsdDataRecord;
+begin
+  with ProjectData.DealBillsData do
+  begin
+    Clear;
+    for i := 0 to FDealBills.Count - 1 do
+    begin
+      vDealBill := FDealBills.DealBills[i];
+      Rec := sddDealBills.Add;
+      Rec.ValueByName('ID').AsInteger := i;
+      Rec.ValueByName('B_Code').AsString := vDealBill.B_Code;
+      Rec.ValueByName('IndexCode').AsString := B_CodeToIndexCode(vDealBill.B_Code);
+      Rec.ValueByName('Name').AsString := vDealBill.Name;
+      Rec.ValueByName('Units').AsString := vDealBill.Units;
+      Rec.ValueByName('Price').AsFloat := PriceRoundTo(vDealBill.Price);
+      Rec.ValueByName('Quantity').AsFloat := QuantityRoundTo(vDealBill.Quantity);
+      Rec.ValueByName('TotalPrice').AsFloat := TotalPriceRoundTo(vDealBill.TotalPrice);
+    end;
+  end;
+end;
+
+{ TDealBill }
+
+function TDealBill.IsParent(AChild: TDealBill): Boolean;
+begin
+  Result := Pos(B_Code+'-', AChild.B_Code) = 1;
+end;
+
+{ TDealBillList }
+
+procedure TDealBillList.AddDealBill(ADealBill: TDealBill);
+begin
+  ClearParent(ADealBill);
+  FList.Add(ADealBill);
+end;
+
+procedure TDealBillList.ClearParent(ADealBill: TDealBill);
+var
+  i: Integer;
+  vDealBill: TDealBill;
+begin
+  for i := 0 to FList.Count - 1 do
+  begin
+    vDealBill := DealBills[i];
+    if vDealBill.IsParent(ADealBill) then
+    begin
+      FList.Delete(i);
+      vDealBill.Free;
+      Break;
+    end;
+  end;
+end;
+
+constructor TDealBillList.Create;
+begin
+  FList := TList.Create;
+end;
+
+destructor TDealBillList.Destroy;
+begin
+  FList.Free;
+  inherited;
+end;
+
+function TDealBillList.GetCount: Integer;
+begin
+  Result := FList.Count;
+end;
+
+function TDealBillList.GetDealBills(AIndex: Integer): TDealBill;
+begin
+  Result := TDealBill(FList.Items[AIndex]);
+end;
+
+end.

Units/DetailExcelImport.pas

@@ -11,20 +11,25 @@ type
   private
     FProjectData: TProjectData;
     FTempFile: string;
-    FExcel: TXlsOutPut;
-
+    FExcel: TXlsOutPut; 
+  protected
     function GetCellValue(AXlsFile: TXLSFile; ARow, ACol: Integer): string;
     function GetCellValueFormat(AXlsFile: TXLSFile; ARow, ACol: Integer): string;
+    function GetCellTrimStr(AXlsFile: TXLSFile; ARow, ACol: Integer): string;
+    function GetCellFloat(AXlsFile: TXLSFile; ARow, ACol: Integer): Double;
 
     procedure BeginImport; virtual; abstract;
     procedure EndImport; virtual; abstract;
 
     procedure Import; virtual; abstract;
   public
-    constructor Create(AProjectData: TProjectData);
+    constructor Create(AProjectData: TProjectData); virtual;
     destructor Destroy; override;
 
     procedure ImportFile(const AFileName: string);
+
+    property ProjectData: TProjectData read FProjectData;
+    property Excel: TXlsOutPut read FExcel;
   end;
 
   // 平面分项清单格式导入，导入至某项目节节点之下
@@ -66,7 +71,7 @@ type
 
     procedure WriteNode(ADataSet: TsdDataSet; ANode: TBillsCacheNode);
     procedure WriteNodes(ADataSet: TsdDataSet);
-
+ protected
     procedure BeginImport; override;
     procedure EndImport; override;
 
@@ -96,6 +101,18 @@ begin
   inherited;
 end;
 
+function TDetailExcelImport.GetCellFloat(AXlsFile: TXLSFile; ARow,
+  ACol: Integer): Double;
+begin
+  Result := StrToFloatDef(GetCellTrimStr(AXlsFile, ARow, ACol), 0);
+end;
+
+function TDetailExcelImport.GetCellTrimStr(AXlsFile: TXLSFile; ARow,
+  ACol: Integer): string;
+begin
+  Result := Trim(GetCellValue(AXlsFile, ARow, ACol));
+end;
+
 function TDetailExcelImport.GetCellValue(AXlsFile: TXLSFile; ARow,
   ACol: Integer): string;
 var
@@ -104,7 +121,7 @@ begin
   Result := '';
   if not Assigned(AXlsFile) or (ARow = -1) or (ACol = -1) then Exit;
   xlsCell := AXlsFile.CellValueX[ARow, ACol];
-  Result := xlsCell.Value;
+  Result := VarToStrDef(xlsCell.Value, '');
 end;
 
 function TDetailExcelImport.GetCellValueFormat(AXlsFile: TXLSFile; ARow,

Units/ExcelImport.pas

@@ -150,7 +150,7 @@ type
   end;
 
   // ºÏͬÇåµ¥
-  TDealBillsExcelImport = class(TExcelImport)
+  {TDealBillsExcelImport = class(TExcelImport)
   private
     FCurRow: Integer;
     FBillsID: Integer;
@@ -168,7 +168,7 @@ type
     procedure LoadColumnsFromHead(ASheet: TSpreadSheet);
     procedure LoadDealBillsData(ASheet: TSpreadSheet);
     procedure Import; override;
-  end;
+  end;}
 
 implementation
 
@@ -769,7 +769,7 @@ end;
 
 { TDealBillsExcelImport }
 
-procedure TDealBillsExcelImport.BeginImport;
+{procedure TDealBillsExcelImport.BeginImport;
 begin
   FProjectData.DealBillsData.sddDealBills.BeginUpdate;
 end;
@@ -867,7 +867,7 @@ begin
     end;
     Inc(FCurRow);
   end;
-end;
+end;}
 
 { TGclBillsExcelImport }