JimiZhang 6 лет назад
Сommit
6e3075f973
100 измененных файлов с 70427 добавлено и 0 удалено
  1. 7 0
      .gitignore
  2. 3 0
      AF/.gitignore
  3. 3224 0
      AF/AboutForm.dfm
  4. 102 0
      AF/AboutForm.pas
  5. 187 0
      AF/AddLeafBillsFrm.dfm
  6. 288 0
      AF/AddLeafBillsFrm.pas
  7. 88 0
      AF/BatchReplaceBillsFrm.dfm
  8. 118 0
      AF/BatchReplaceBillsFrm.pas
  9. 143 0
      AF/BidLotAliasFrm.dfm
  10. 111 0
      AF/BidLotAliasFrm.pas
  11. 107 0
      AF/CheckPosForm.dfm
  12. 58 0
      AF/CheckPosForm.pas
  13. 1081 0
      AF/Common/FlashForm.dfm
  14. 22 0
      AF/Common/FlashForm.pas
  15. 1658 0
      AF/ExportExFrm.dfm
  16. 302 0
      AF/ExportExFrm.pas
  17. BIN
      AF/FlashForm.ddp
  18. 3316 0
      AF/FlashForm.dfm
  19. 22 0
      AF/FlashForm.pas
  20. 131 0
      AF/NewProjectFrm.dfm
  21. 293 0
      AF/NewProjectFrm.pas
  22. 816 0
      AF/RecycleBinFrm.dfm
  23. 119 0
      AF/RecycleBinFrm.pas
  24. 1060 0
      AF/ScAuthFrm.dfm
  25. 294 0
      AF/ScAuthFrm.pas
  26. BIN
      AF/ScLicenseCodeFrm.dfm
  27. 70 0
      AF/ScLicenseCodeFrm.pas
  28. 11568 0
      AF/ScLoginFrm.dfm
  29. 145 0
      AF/ScLoginFrm.pas
  30. 11403 0
      AF/ScModifyPwdFrm.dfm
  31. 227 0
      AF/ScModifyPwdFrm.pas
  32. 36 0
      AF/ScProgressFrm.dfm
  33. 44 0
      AF/ScProgressFrm.pas
  34. 228 0
      AF/ScUserInfoFrm.dfm
  35. 369 0
      AF/ScUserInfoFrm.pas
  36. 934 0
      AF/StdLibsManagerFrm.dfm
  37. 294 0
      AF/StdLibsManagerFrm.pas
  38. 18 0
      AF/beProgressFrm.dfm
  39. 37 0
      AF/beProgressFrm.pas
  40. 20 0
      CU/CommonIntfUnit.pas
  41. 1478 0
      CU/ConstMethodUnit.pas
  42. 164 0
      CU/ConstTypeUnit.pas
  43. 313 0
      CU/ConstVarUnit.pas
  44. 112 0
      CU/CustomDoc.pas
  45. 516 0
      CU/ExportDecorateUnit.pas
  46. 1415 0
      CU/ExportExcel.pas
  47. 377 0
      CU/FXQDManagerUnit.pas
  48. 70 0
      CU/FileOprUnit.pas
  49. 94 0
      CU/ImportDecorate.pas
  50. 871 0
      CU/ImportExcel.pas
  51. 616 0
      CU/ProjectFileManager.pas
  52. 1272 0
      CU/ProjectMergeSplitUnit.pas
  53. 182 0
      CU/ProjectPropertyThread.pas
  54. 516 0
      CU/ProjectPropertyUnit.pas
  55. 611 0
      CU/ScAutoUpdateUnit.pas
  56. 820 0
      CU/ScBillsTree.pas
  57. 223 0
      CU/ScConfig.pas
  58. 813 0
      CU/ScCopyBills.pas
  59. 786 0
      CU/ScEvaluate.pas
  60. 2348 0
      CU/ScFileArchiver.pas
  61. 417 0
      CU/ScFileProviders.pas
  62. 2723 0
      CU/ScKindsOfTrees.pas
  63. 827 0
      CU/ScProjectManager.pas
  64. 224 0
      CU/ScStdBillsCtrl.pas
  65. 129 0
      CU/ScTables.pas
  66. 68 0
      CU/ScUpdateDataBase.pas
  67. 59 0
      CU/SingleObjectAggregateUnit.pas
  68. 31 0
      DB/BidLotDM.dfm
  69. 248 0
      DB/BidLotDM.pas
  70. BIN
      DB/DataBase.ddp
  71. 936 0
      DB/DataBase.dfm
  72. 4769 0
      DB/DataBase.pas
  73. 435 0
      DB/DetailItemsDM.dfm
  74. 1027 0
      DB/DetailItemsDM.pas
  75. 173 0
      DB/HisRestorePointDM.dfm
  76. 298 0
      DB/HisRestorePointDM.pas
  77. 45 0
      DB/LocateBillsDM.dfm
  78. 198 0
      DB/LocateBillsDM.pas
  79. 57 0
      DB/ProjectManagerDM.dfm
  80. 661 0
      DB/ProjectManagerDM.pas
  81. 145 0
      DB/ProjectPropertyDM.dfm
  82. 157 0
      DB/ProjectPropertyDM.pas
  83. 164 0
      DB/RecycleBinDM.dfm
  84. 303 0
      DB/RecycleBinDM.pas
  85. 102 0
      DB/ScExprsDM.dfm
  86. 161 0
      DB/ScExprsDM.pas
  87. 40 0
      DB/ScProvinceFrm.dfm
  88. 133 0
      DB/ScProvinceFrm.pas
  89. BIN
      DB/ScReportDM.ddp
  90. 110 0
      DB/ScReportDM.dfm
  91. 290 0
      DB/ScReportDM.pas
  92. 740 0
      DB/StdBillsLibDM.dfm
  93. 1715 0
      DB/StdBillsLibDM.pas
  94. 44 0
      Dpr/BillsEditor.cfg
  95. 158 0
      Dpr/BillsEditor.dof
  96. 99 0
      Dpr/BillsEditor.dpr
  97. BIN
      Dpr/BillsEditor.res
  98. 45 0
      Dpr/Common/BillsEditor.cfg
  99. 156 0
      Dpr/Common/BillsEditor.dof
  100. 0 0
      Dpr/Common/BillsEditor.dpr

+ 7 - 0
.gitignore

@@ -0,0 +1,7 @@
+*.~pas
+*.scc
+*.dcu
+*.~ddp
+*.~dfm
+*.~dpr
+*.vcx

+ 3 - 0
AF/.gitignore

@@ -0,0 +1,3 @@
+*.dcu
+*.~ddp
+*.~dfm

Разница между файлами не показана из-за своего большого размера
+ 3224 - 0
AF/AboutForm.dfm


+ 102 - 0
AF/AboutForm.pas

@@ -0,0 +1,102 @@
+unit AboutForm;
+
+interface
+
+uses
+  Windows, SysUtils, ShellAPI, Graphics, Forms, ConstMethodUnit,
+  Controls, Classes, StdCtrls, ExtCtrls, ConstVarUnit;
+
+type
+  TAboutFrm = class(TForm)
+    Label1: TLabel;
+    Label2: TLabel;
+    Label3: TLabel;
+    Label5: TLabel;
+    lblVersion: TLabel;
+    Label10: TLabel;
+    Label6: TLabel;
+    Label7: TLabel;
+    Label4: TLabel;
+    Label13: TLabel;
+    lblPhone: TLabel;
+    Label15: TLabel;
+    lblWebSite2: TLabel;
+    lblEmail2: TLabel;
+    Label8: TLabel;
+    Panel1: TPanel;
+    Image1: TImage;
+    Panel2: TPanel;
+    Button1: TButton;
+    Panel3: TPanel;
+    procedure lblWebSite2Click(Sender: TObject);
+    procedure lblWebSite2MouseEnter(Sender: TObject);
+    procedure lblWebSite2MouseLeave(Sender: TObject);
+    procedure lblEmail2Click(Sender: TObject);
+    procedure lblEmail2MouseEnter(Sender: TObject);
+    procedure lblEmail2MouseLeave(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+  end;
+
+implementation
+
+{$R *.dfm}
+
+procedure TAboutFrm.lblWebSite2Click(Sender: TObject);
+begin
+  ShellExecute(Handle, nil, PChar(lblWebSite2.Caption), nil, nil, SW_SHOWNORMAL);
+end;
+
+procedure TAboutFrm.lblWebSite2MouseEnter(Sender: TObject);
+begin
+  TLabel(Sender).Font.Color := clHighLight;
+  Screen.Cursor := crHandPoint;
+end;
+
+procedure TAboutFrm.lblWebSite2MouseLeave(Sender: TObject);
+begin
+  TLabel(Sender).Font.Color := clHotLight;
+  Screen.Cursor := crDefault;
+end;
+
+procedure TAboutFrm.lblEmail2Click(Sender: TObject);
+begin
+  Shellexecute(Handle, 'open',
+    'mailto:"纵横客服中心"<support@smartcost.com.cn>?subject=关于SmartCost的反馈',
+    '关于SmartCost的反馈', '', SW_SHOW);
+end;
+
+procedure TAboutFrm.lblEmail2MouseEnter(Sender: TObject);
+begin
+  TLabel(Sender).Font.Color := clHighLight;
+  Screen.Cursor := crHandPoint;
+end;
+
+procedure TAboutFrm.lblEmail2MouseLeave(Sender: TObject);
+begin
+  TLabel(Sender).Font.Color := clHotLight;
+  Screen.Cursor := crDefault;
+end;
+
+procedure TAboutFrm.FormCreate(Sender: TObject);
+begin
+  lblVersion.Caption := GetFileVersion;
+  {$IFDEF _beCommon}
+  Label3.Caption := SoftWareName_ZY_Common;
+  {$ELSE}
+    {$IFDEF _ScEncrypt}
+    Label3.Caption := SoftWareName_ZY;
+    {$ELSE}
+      {$IFDEF _beOnLine}
+      Label3.Caption := SoftWareName_OnLine;
+      {$ELSE}
+      Label3.Caption := SoftWareName_XX;
+      {$ENDIF}
+    {$ENDIF}
+  {$ENDIF}
+end;
+
+end.

+ 187 - 0
AF/AddLeafBillsFrm.dfm

@@ -0,0 +1,187 @@
+object AddLeafBillsForm: TAddLeafBillsForm
+  Left = 527
+  Top = 206
+  BorderIcons = [biSystemMenu]
+  BorderStyle = bsSingle
+  Caption = #25209#37327#25554#20837#21518#39033
+  ClientHeight = 382
+  ClientWidth = 481
+  Color = clBtnFace
+  Font.Charset = ANSI_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -12
+  Font.Name = #23435#20307
+  Font.Style = []
+  OldCreateOrder = False
+  Position = poMainFormCenter
+  PixelsPerInch = 96
+  TextHeight = 12
+  object pnlPosition: TPanel
+    Left = 0
+    Top = 0
+    Width = 481
+    Height = 196
+    Align = alClient
+    BevelOuter = bvNone
+    TabOrder = 0
+    object lblPostion: TLabel
+      Left = 8
+      Top = 8
+      Width = 84
+      Height = 12
+      Caption = #37096#20301#25968#37327#22797#26680#34920
+      Font.Charset = ANSI_CHARSET
+      Font.Color = clBlue
+      Font.Height = -12
+      Font.Name = #23435#20307
+      Font.Style = []
+      ParentFont = False
+    end
+    object zgPosition: TZJGrid
+      Left = 3
+      Top = 27
+      Width = 474
+      Height = 166
+      OptionsEx = []
+      ColCount = 8
+      ShowGridLine = False
+      DefaultColWidth = 50
+      DefaultFixedColWidth = 25
+      Selection.AlphaBlend = False
+      Selection.TransparentColor = False
+      OnCustomPaste = zgPositionCustomPaste
+      OnMouseDown = zgPositionMouseDown
+    end
+    object pnlPositionSpr: TPanel
+      Left = 99
+      Top = 14
+      Width = 378
+      Height = 2
+      BevelInner = bvLowered
+      BevelOuter = bvNone
+      TabOrder = 1
+    end
+  end
+  object pnlBills: TPanel
+    Left = 0
+    Top = 196
+    Width = 481
+    Height = 135
+    Align = alBottom
+    BevelOuter = bvNone
+    TabOrder = 1
+    object lblBills: TLabel
+      Left = 8
+      Top = 8
+      Width = 48
+      Height = 12
+      Caption = #28165#21333#32534#21495
+      Font.Charset = ANSI_CHARSET
+      Font.Color = clBlue
+      Font.Height = -12
+      Font.Name = #23435#20307
+      Font.Style = []
+      ParentFont = False
+    end
+    object zgBills: TZJGrid
+      Left = 2
+      Top = 27
+      Width = 475
+      Height = 105
+      OptionsEx = []
+      ColCount = 4
+      RowCount = 7
+      ShowGridLine = False
+      DefaultColWidth = 50
+      DefaultFixedColWidth = 60
+      Selection.AlphaBlend = False
+      Selection.TransparentColor = False
+      OnMouseDown = zgPositionMouseDown
+    end
+    object pnlBillsSpr: TPanel
+      Left = 62
+      Top = 14
+      Width = 414
+      Height = 2
+      BevelInner = bvLowered
+      BevelOuter = bvNone
+      TabOrder = 1
+    end
+  end
+  object pnlOther: TPanel
+    Left = 0
+    Top = 331
+    Width = 481
+    Height = 51
+    Align = alBottom
+    BevelOuter = bvNone
+    TabOrder = 2
+    object leBeginCode: TLabeledEdit
+      Left = 96
+      Top = 1
+      Width = 139
+      Height = 20
+      EditLabel.Width = 90
+      EditLabel.Height = 12
+      EditLabel.Caption = #36215#22987#37096#20301#32534#21495#65306' '
+      EditLabel.Font.Charset = ANSI_CHARSET
+      EditLabel.Font.Color = clBlue
+      EditLabel.Font.Height = -12
+      EditLabel.Font.Name = #23435#20307
+      EditLabel.Font.Style = []
+      EditLabel.ParentFont = False
+      LabelPosition = lpLeft
+      TabOrder = 0
+    end
+    object btnOK: TButton
+      Left = 321
+      Top = 25
+      Width = 72
+      Height = 23
+      Caption = #30830'  '#23450
+      TabOrder = 1
+      OnClick = btnOKClick
+    end
+    object btnCancel: TButton
+      Left = 405
+      Top = 25
+      Width = 72
+      Height = 23
+      Caption = #21462'  '#28040
+      ModalResult = 2
+      TabOrder = 2
+    end
+    object leDrawingCode: TLabeledEdit
+      Left = 319
+      Top = 0
+      Width = 157
+      Height = 20
+      EditLabel.Width = 66
+      EditLabel.Height = 12
+      EditLabel.Caption = #22270'('#20876')'#21495#65306' '
+      EditLabel.Font.Charset = ANSI_CHARSET
+      EditLabel.Font.Color = clBlue
+      EditLabel.Font.Height = -12
+      EditLabel.Font.Name = #23435#20307
+      EditLabel.Font.Style = []
+      EditLabel.ParentFont = False
+      LabelPosition = lpLeft
+      TabOrder = 3
+    end
+  end
+  object dxpmAddLeafBills: TdxBarPopupMenu
+    BarManager = MainFrm.dxBarManager
+    ItemLinks = <
+      item
+        Item = MainFrm.dxCut
+        Visible = True
+      end
+      item
+        Item = MainFrm.dxPaste
+        Visible = True
+      end>
+    UseOwnFont = False
+    Left = 139
+    Top = 99
+  end
+end

+ 288 - 0
AF/AddLeafBillsFrm.pas

@@ -0,0 +1,288 @@
+unit AddLeafBillsFrm;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, StdCtrls, ExtCtrls, ZJGrid, DataBase, ZjIDTree, ConstMethodUnit,
+  dxBar;
+
+type
+  TAddLeafBillsForm = class(TForm)
+    pnlPosition: TPanel;
+    zgPosition: TZJGrid;
+    pnlPositionSpr: TPanel;
+    lblPostion: TLabel;
+    pnlBills: TPanel;
+    lblBills: TLabel;
+    zgBills: TZJGrid;
+    pnlBillsSpr: TPanel;
+    pnlOther: TPanel;
+    leBeginCode: TLabeledEdit;
+    btnOK: TButton;
+    btnCancel: TButton;
+    leDrawingCode: TLabeledEdit;
+    dxpmAddLeafBills: TdxBarPopupMenu;
+    procedure zgPositionCustomPaste(Sender: TObject; ABounds: TRect;
+      ASourSheet: TZjSheet);
+    procedure zgBillsCustomPaste(Sender: TObject; ABounds: TRect;
+      ASourSheet: TZjSheet);
+    procedure btnOKClick(Sender: TObject);
+    procedure zgPositionMouseDown(Sender: TObject; Button: TMouseButton;
+      Shift: TShiftState; X, Y: Integer);
+  private
+    FBillsData: TDMDataBase;
+
+    procedure ResetPositionGridHead;
+    procedure ResetBillsGridHead;
+    procedure PasteData(AGrid: TZJGrid; ABounds: TRect; ASourSheet: TZjSheet);
+    procedure SetRowAndColumnCount(AGrid: TZJGrid; ASourSheet: TZjSheet);
+
+    function ReplaceLastNum(const ACode: string; ARow: Integer): string;
+    procedure SetXmjNodeData(ARow: Integer; ANode: TZjIDTreeNode);
+    procedure AddXmjNode(ARow, AParentID, ANextSiblingID: Integer);
+    procedure AddBillsNode(AQtyRow, ARow: Integer; AParent: TZjIDTreeNode);
+    procedure AddBillsNodes(AQtyRow: Integer; AParent: TZjIDTreeNode);
+    procedure BatchAddBillsNodes(AParentID, ANextSiblingID: Integer);
+  public
+    procedure Init;
+    procedure Execute(ABillsData: TDMDataBase);
+  end;
+
+procedure AddLeafBills(ABillsData: TDMDataBase);
+
+implementation
+
+uses ScBillsTree;
+
+{$R *.dfm}
+
+procedure AddLeafBills(ABillsData: TDMDataBase);
+var
+  AddLeafBillsForm: TAddLeafBillsForm;
+begin
+  AddLeafBillsForm := TAddLeafBillsForm.Create(nil);
+  try
+    AddLeafBillsForm.Init;
+    if AddLeafBillsForm.ShowModal = mrOK then
+      AddLeafBillsForm.Execute(ABillsData);
+  finally
+    AddLeafBillsForm.Free;
+  end;
+end;
+
+{ TAddLeafBillsForm }
+
+procedure TAddLeafBillsForm.AddXmjNode(ARow, AParentID, ANextSiblingID: Integer);
+var
+  ztnNode: TZjIDTreeNode;
+begin
+  if zgPosition.Cells[1, ARow].Text = '' then Exit;
+
+  ztnNode := FBillsData.BillsTree.Add(AParentID, ANextSiblingID);
+  SetXmjNodeData(ARow, ztnNode);
+  AddBillsNodes(ARow, ztnNode);
+end;
+
+procedure TAddLeafBillsForm.BatchAddBillsNodes(AParentID, ANextSiblingID: Integer);
+var
+  iRow: Integer;
+begin
+  for iRow := 1 to zgPosition.RowCount - 1 do
+    AddXmjNode(iRow, AParentID, ANextSiblingID);
+end;
+
+procedure TAddLeafBillsForm.Execute(ABillsData: TDMDataBase);
+begin
+  FBillsData := ABillsData;
+  with FBillsData.BillsTree do
+    if Assigned(Selected) and Assigned(Selected.Parent) then
+      BatchAddBillsNodes(Selected.ParentID, Selected.NextSiblingID);
+end;
+
+procedure TAddLeafBillsForm.Init;
+begin
+  ResetPositionGridHead;
+  ResetBillsGridHead;
+end;
+
+procedure TAddLeafBillsForm.PasteData(AGrid: TZJGrid; ABounds: TRect;
+  ASourSheet: TZjSheet);
+var
+  iCol, iRow: Integer;
+begin
+  for iRow := 0 to ASourSheet.RowCount - 1 do
+    for iCol := 0 to ASourSheet.ColCount - 1 do
+    begin
+      with AGrid.Cells[iCol + ABounds.Left , iRow + ABounds.Top] do
+        if CanEdit then Text := ASourSheet.Values[iCol, iRow];
+    end;
+end;
+
+function TAddLeafBillsForm.ReplaceLastNum(const ACode: string;
+  ARow: Integer): string;
+var
+  sgs: TStringList;
+begin
+  sgs := TStringList.Create;
+  try
+    sgs.Delimiter := '-';
+    sgs.DelimitedText := ACode;
+    sgs[sgs.Count - 1] := IntToStr(StrToInt(sgs[sgs.Count - 1]) + ARow - 1);
+    Result := sgs.DelimitedText;
+  finally
+    sgs.Free;
+  end;
+end;
+
+procedure TAddLeafBillsForm.ResetPositionGridHead;
+var
+  iCol: Integer;
+begin
+  zgPosition.Cells[1, 0].Text := '部位';
+  zgPosition.ColWidths[1] := 120;
+  for iCol := 2 to zgPosition.ColCount - 1 do
+  begin
+    zgPosition.Cells[iCol, 0].Text := '清单' + IntToStr(iCol - 1);
+    zgPosition.ColWidths[iCol] := 50;
+  end;
+end;
+
+procedure TAddLeafBillsForm.SetRowAndColumnCount(AGrid: TZJGrid;
+  ASourSheet: TZjSheet);
+begin
+  if AGrid.ColCount < ASourSheet.ColCount + AGrid.CurCol then
+    AGrid.ColCount := ASourSheet.ColCount + AGrid.CurCol;
+  if AGrid.RowCount < ASourSheet.RowCount + AGrid.CurRow + 1 then
+    AGrid.RowCount := ASourSheet.RowCount + AGrid.CurRow + 1;
+end;
+
+procedure TAddLeafBillsForm.SetXmjNodeData(ARow: Integer;
+  ANode: TZjIDTreeNode);
+begin
+  with FBillsData do
+    if cdsBills.FindKey([ANode.ID]) then
+    begin
+      cdsBills.Edit;
+      cdsBillsCode.AsString := ReplaceLastNum(leBeginCode.Text, ARow);
+      cdsBillsName.AsString := zgPosition.Cells[1, ARow].Text;
+      cdsBillsDrawingCode.AsString := leDrawingCode.Text;
+      cdsBills.Post;
+    end;
+end;
+
+procedure TAddLeafBillsForm.zgPositionCustomPaste(Sender: TObject;
+  ABounds: TRect; ASourSheet: TZjSheet);
+begin
+  SetRowAndColumnCount(TZJGrid(Sender), ASourSheet);
+  ResetPositionGridHead;
+  PasteData(TZJGrid(Sender), ABounds, ASourSheet);
+  zgBills.RowCount := zgPosition.ColCount - 1;
+  ResetBillsGridHead;
+end;
+
+procedure TAddLeafBillsForm.zgBillsCustomPaste(Sender: TObject;
+  ABounds: TRect; ASourSheet: TZjSheet);
+begin
+  SetRowAndColumnCount(TZJGrid(Sender), ASourSheet);
+  PasteData(TZJGrid(Sender), ABounds, ASourSheet);
+end;
+
+procedure TAddLeafBillsForm.AddBillsNodes(AQtyRow: Integer;
+  AParent: TZjIDTreeNode);
+var
+  iRow: Integer;
+begin
+  for iRow := 1 to zgBills.RowCount - 1 do
+    AddBillsNode(AQtyRow, iRow, AParent);
+end;
+
+procedure TAddLeafBillsForm.AddBillsNode(AQtyRow, ARow: Integer;
+  AParent: TZjIDTreeNode);
+var
+  ztnNode: TZjIDTreeNode;
+  fQuantity: Double;
+begin
+  if (zgBills.Cells[1, ARow].Text = '') or
+     (zgPosition.Cells[ARow + 1, AQtyRow].Text = '') or
+     not TryStrToFloat(zgPosition.Cells[ARow + 1, AQtyRow].Text, fQuantity) then Exit;
+
+  ztnNode := FBillsData.BillsTree.Add(AParent.ID, -1);
+  with FBillsData do
+    if cdsBills.FindKey([ztnNode.ID]) then
+    begin
+      cdsBills.Edit;
+      cdsBillsB_Code.AsString := zgBills.Cells[1, ARow].Text;
+      cdsBillsName.AsString := zgBills.Cells[2, ARow].Text;
+      cdsBillsUnits.AsString := zgBills.Cells[3, ARow].Text;
+      cdsBillsQuantity.AsString := zgPosition.Cells[ARow + 1, AQtyRow].Text;
+      cdsBills.Post;
+    end;
+end;
+
+procedure TAddLeafBillsForm.ResetBillsGridHead;
+var
+  iRow: Integer;
+begin
+  zgBills.Cells[1, 0].Text := '编号';
+  zgBills.ColWidths[1] := 80;
+  zgBills.Cells[2, 0].Text := '名称';
+  zgBills.ColWidths[2] := 120;
+  zgBills.Cells[3, 0].Text := '单位';
+  zgBills.ColWidths[3] := 60;
+  for iRow := 1 to zgBills.RowCount - 1 do
+    zgBills.Cells[0, iRow].Text := '清单' + IntToStr(iRow);
+end;
+
+procedure TAddLeafBillsForm.btnOKClick(Sender: TObject);
+
+  function CheckGridHasData(AGrid: TZJGrid): Boolean;
+  var
+    iRow: Integer;
+  begin
+    Result := False;
+    for iRow := 1 to AGrid.RowCount - 1 do
+      if AGrid.Cells[1, iRow].Text <> '' then
+      begin
+        Result := True;
+        Break;
+      end;
+  end;
+
+  function CheckBeginCodeAvailable(const ACode: string): Boolean;
+  var
+    sgsCode: TStrings;
+    iCode: Integer;
+  begin
+    sgsCode := TStringList.Create;
+    try
+      sgsCode.Delimiter := '-';
+      sgsCode.DelimitedText := ACode;
+
+      Result := TryStrToInt(sgsCode[sgsCode.Count - 1], iCode);
+    finally
+      sgsCode.Free;
+    end;
+  end;
+
+begin
+  if not CheckGridHasData(zgPosition) then
+    MessageError(Handle, '请输入部位数量复核数据!')
+  else if not CheckGridHasData(zgBills) then
+    MessageError(Handle, '请输入清单编号等数据!')
+  else if leBeginCode.Text = '' then
+    MessageError(Handle, '请输入起始编号!')
+  else if not CheckBeginCodeAvailable(leBeginCode.Text) then
+    MessageError(Handle, '请输入规范的起始部位编号,如1或1-1等。')
+  else
+    ModalResult := mrOK;
+end;
+
+procedure TAddLeafBillsForm.zgPositionMouseDown(Sender: TObject;
+  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+begin
+  if Button = mbRight then
+    dxpmAddLeafBills.PopupFromCursorPos;
+end;
+
+end.

+ 88 - 0
AF/BatchReplaceBillsFrm.dfm

@@ -0,0 +1,88 @@
+object BatchReplaceBillsForm: TBatchReplaceBillsForm
+  Left = 473
+  Top = 351
+  Width = 381
+  Height = 155
+  Caption = #25209#37327#26367#25442#28165#21333#25968#25454
+  Color = clBtnFace
+  Font.Charset = ANSI_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -12
+  Font.Name = #23435#20307
+  Font.Style = []
+  OldCreateOrder = False
+  Position = poMainFormCenter
+  PixelsPerInch = 96
+  TextHeight = 12
+  object pnlBills: TPanel
+    Left = 0
+    Top = 0
+    Width = 373
+    Height = 91
+    Align = alClient
+    BevelOuter = bvNone
+    TabOrder = 0
+    object lblBills: TLabel
+      Left = 8
+      Top = 8
+      Width = 36
+      Height = 12
+      Caption = #26367#25442#20026
+      Font.Charset = ANSI_CHARSET
+      Font.Color = clBlue
+      Font.Height = -12
+      Font.Name = #23435#20307
+      Font.Style = []
+      ParentFont = False
+    end
+    object zgBills: TZJGrid
+      Left = 3
+      Top = 27
+      Width = 366
+      Height = 105
+      OptionsEx = []
+      RowCount = 2
+      ShowGridLine = False
+      DefaultColWidth = 60
+      DefaultFixedColWidth = 25
+      Selection.AlphaBlend = False
+      Selection.TransparentColor = False
+    end
+    object pnlBillsSpr: TPanel
+      Left = 47
+      Top = 14
+      Width = 320
+      Height = 2
+      BevelInner = bvLowered
+      BevelOuter = bvNone
+      TabOrder = 1
+    end
+  end
+  object pnlOther: TPanel
+    Left = 0
+    Top = 91
+    Width = 373
+    Height = 30
+    Align = alBottom
+    BevelOuter = bvNone
+    TabOrder = 1
+    object btnOk: TButton
+      Left = 213
+      Top = 5
+      Width = 73
+      Height = 21
+      Caption = #30830'  '#23450
+      TabOrder = 0
+      OnClick = btnOkClick
+    end
+    object btnCancel: TButton
+      Left = 297
+      Top = 5
+      Width = 73
+      Height = 21
+      Caption = #21462'  '#28040
+      ModalResult = 2
+      TabOrder = 1
+    end
+  end
+end

+ 118 - 0
AF/BatchReplaceBillsFrm.pas

@@ -0,0 +1,118 @@
+unit BatchReplaceBillsFrm;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, StdCtrls, ExtCtrls, ConstMethodUnit, ZJGrid, DataBase;
+
+type
+  TBatchReplaceBillsForm = class(TForm)
+    pnlBills: TPanel;
+    lblBills: TLabel;
+    zgBills: TZJGrid;
+    pnlBillsSpr: TPanel;
+    pnlOther: TPanel;
+    btnOk: TButton;
+    btnCancel: TButton;
+    procedure btnOkClick(Sender: TObject);
+  private
+    FBillsData: TDMDataBase;
+    FOrgB_Code: string;
+    FOrgName: string;
+    FOrgUnits: string;
+  public
+    procedure InitGridHead;
+    procedure Init(ABillsData: TDMDataBase);
+    procedure Execute;
+  end;
+
+procedure BatchReplaceBillsData(ABillsData: TDMDataBase);
+
+implementation
+
+uses DB;
+
+{$R *.dfm}
+
+procedure BatchReplaceBillsData(ABillsData: TDMDataBase);
+var
+  BatchReplaceBillsForm: TBatchReplaceBillsForm;
+begin
+  BatchReplaceBillsForm := TBatchReplaceBillsForm.Create(nil);
+  try
+    BatchReplaceBillsForm.Init(ABillsData);
+    if BatchReplaceBillsForm.ShowModal = mrOk then
+      BatchReplaceBillsForm.Execute;
+  finally
+    BatchReplaceBillsForm.Free;
+  end;
+end;
+
+{ TBatchReplaceBillsForm }
+
+procedure TBatchReplaceBillsForm.btnOkClick(Sender: TObject);
+begin
+  if zgBills.Cells[1, 1].Text = '' then
+    MessageError(Handle, 'ワ怀⻌ラ等晤瘍ㄐ')
+  else
+    ModalResult := mrOK;
+end;
+
+procedure TBatchReplaceBillsForm.Execute;
+begin
+  with FBillsData do
+  begin
+    cdsBills.First;
+    while not cdsBills.Eof do
+    begin
+      if SameText(Trim(cdsBillsB_Code.AsString), FOrgB_Code) and
+         SameText(Trim(cdsBillsName.AsString), FOrgName) and
+         SameText(Trim(cdsBillsUnits.AsString), FOrgUnits) then
+      begin
+        cdsBills.Edit;
+        cdsBillsB_Code.AsString := zgBills.Cells[1, 1].Text;
+        cdsBillsName.AsString := zgBills.Cells[2, 1].Text;
+        cdsBillsUnits.AsString := zgBills.Cells[3, 1].Text;
+        if StrToFloatDef(zgBills.Cells[4, 1].Text, 0) <> 0 then
+          cdsBillsUnitPrice.AsFloat := StrToFloatDef(zgBills.Cells[4, 1].Text, 0);
+        cdsBills.Post;
+      end;
+      cdsBills.Next;
+    end;
+  end;
+end;
+
+procedure TBatchReplaceBillsForm.Init(ABillsData: TDMDataBase);
+begin
+  FBillsData := ABillsData;
+  InitGridHead;
+  with FBillsData do
+  begin
+    FOrgB_Code := Trim(cdsBillsB_Code.AsString);
+    FOrgName := Trim(cdsBillsName.AsString);
+    FOrgUnits := Trim(cdsBillsUnits.AsString);
+    zgBills.Cells[1, 1].Text := cdsBillsB_Code.AsString;
+    zgBills.Cells[1, 1].TextAlign := gaCenterLeft;
+    zgBills.Cells[2, 1].Text := cdsBillsName.AsString;
+    zgBills.Cells[2, 1].TextAlign := gaCenterLeft;
+    zgBills.Cells[3, 1].Text := cdsBillsUnits.AsString;
+    zgBills.Cells[3, 1].TextAlign := gaCenterLeft;
+    zgBills.Cells[4, 1].Text := cdsBillsUnitPrice.AsString;
+    zgBills.Cells[4, 1].TextAlign := gaCenterRight;
+  end;
+end;
+
+procedure TBatchReplaceBillsForm.InitGridHead;
+begin
+  zgBills.Cells[1, 0].Text := 'ラ等晤瘍';
+  zgBills.ColWidths[1] := 80;
+  zgBills.Cells[2, 0].Text := '靡備';
+  zgBills.ColWidths[2] := 120;
+  zgBills.Cells[3, 0].Text := '等弇';
+  zgBills.ColWidths[3] := 50;
+  zgBills.Cells[4, 0].Text := '等歎';
+  zgBills.ColWidths[4] := 60;
+end;
+
+end.

+ 143 - 0
AF/BidLotAliasFrm.dfm

@@ -0,0 +1,143 @@
+object BidAliasForm: TBidAliasForm
+  Left = 391
+  Top = 213
+  BorderIcons = [biSystemMenu]
+  BorderStyle = bsSingle
+  Caption = #26631#27573#31616#31216
+  ClientHeight = 356
+  ClientWidth = 392
+  Color = clBtnFace
+  Font.Charset = ANSI_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -12
+  Font.Name = #23435#20307
+  Font.Style = []
+  OldCreateOrder = False
+  Position = poMainFormCenter
+  OnShow = FormShow
+  PixelsPerInch = 96
+  TextHeight = 12
+  object zgBidLot: TZJGrid
+    Left = 0
+    Top = 31
+    Width = 392
+    Height = 305
+    Options = [goRangeSelect, goRowSizing, goColSizing, goCellNotMaintainData, goFixedRowShowNo, goFixedColShowNo, goAlwaysShowSelection]
+    OptionsEx = []
+    ColCount = 3
+    RowCount = 3
+    ShowGridLine = False
+    DefaultColWidth = 73
+    DefaultFixedColWidth = 25
+    Selection.AlphaBlend = False
+    Selection.TransparentColor = False
+    OnCellTextChanging = zgBidLotCellTextChanging
+    OnMouseDown = zgBidLotMouseDown
+    Align = alClient
+  end
+  object Panel1: TPanel
+    Left = 0
+    Top = 0
+    Width = 392
+    Height = 31
+    Align = alTop
+    BevelOuter = bvNone
+    TabOrder = 1
+    DesignSize = (
+      392
+      31)
+    object ldeShortName: TLabeledEdit
+      Left = 62
+      Top = 7
+      Width = 183
+      Height = 20
+      EditLabel.Width = 54
+      EditLabel.Height = 12
+      EditLabel.Caption = #26631#27573#31616#31216':'
+      LabelPosition = lpLeft
+      TabOrder = 0
+    end
+    object btnAlter: TButton
+      Left = 246
+      Top = 5
+      Width = 70
+      Height = 23
+      Anchors = [akTop, akRight]
+      Caption = #20462#25913
+      TabOrder = 1
+      OnClick = btnAlterClick
+    end
+    object btnSave: TButton
+      Left = 317
+      Top = 5
+      Width = 70
+      Height = 23
+      Anchors = [akTop, akRight]
+      Caption = #20445#23384
+      TabOrder = 2
+      OnClick = btnSaveClick
+    end
+  end
+  object StatusBar1: TStatusBar
+    Left = 0
+    Top = 336
+    Width = 392
+    Height = 20
+    Panels = <
+      item
+        Text = #24314#35774#39033#30446':'
+        Width = 160
+      end
+      item
+        Text = #26631#27573':'
+        Width = 130
+      end
+      item
+        Text = #31616#31216':'
+        Width = 50
+      end>
+  end
+  object zaBidLot: TZjGridDBA
+    Columns = <
+      item
+        Title.Caption = #26631#27573#21517#31216
+        Title.CaptionAcrossCols = '1'
+        Title.Font.Charset = GB2312_CHARSET
+        Title.Font.Color = clWindowText
+        Title.Font.Height = -12
+        Title.Font.Name = #23435#20307
+        Title.Font.Style = []
+        Alignment = taLeftJustify
+        Font.Charset = GB2312_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -12
+        Font.Name = #23435#20307
+        Font.Style = []
+        FieldName = 'ProjName'
+        Width = 200
+        ReadOnly = True
+      end
+      item
+        Title.Caption = #26631#27573#31616#31216
+        Title.CaptionAcrossCols = '1'
+        Title.Font.Charset = GB2312_CHARSET
+        Title.Font.Color = clWindowText
+        Title.Font.Height = -12
+        Title.Font.Name = #23435#20307
+        Title.Font.Style = []
+        Alignment = taLeftJustify
+        Font.Charset = GB2312_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -12
+        Font.Name = #23435#20307
+        Font.Style = []
+        FieldName = 'AliasName'
+        ReadOnly = False
+      end>
+    Grid = zgBidLot
+    ExtendRowCount = 2
+    OnGridRowMoved = zaBidLotGridRowMoved
+    Left = 224
+    Top = 80
+  end
+end

+ 111 - 0
AF/BidLotAliasFrm.pas

@@ -0,0 +1,111 @@
+unit BidLotAliasFrm;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, StdCtrls, ExtCtrls, ZjGridDBA, ZJGrid, DB, ComCtrls;
+
+type
+  TBidAliasForm = class(TForm)
+    zgBidLot: TZJGrid;
+    zaBidLot: TZjGridDBA;
+    Panel1: TPanel;
+    ldeShortName: TLabeledEdit;
+    btnAlter: TButton;
+    btnSave: TButton;
+    StatusBar1: TStatusBar;
+    procedure zgBidLotMouseDown(Sender: TObject; Button: TMouseButton;
+      Shift: TShiftState; X, Y: Integer);
+    procedure btnAlterClick(Sender: TObject);
+    procedure btnSaveClick(Sender: TObject);
+    procedure zgBidLotCellTextChanging(Sender: TObject;
+      const ACoord: TPoint; var NewValue: String; var Accept: Boolean);
+    procedure zaBidLotGridRowMoved(Sender: TObject; const ACoord: TPoint;
+      ADist: Integer; ADir: TZjMoveDirection);
+    procedure FormShow(Sender: TObject);
+  private
+    FProject: TObject;
+    FBuildProjectName: string;
+
+    function GetDataSet: TDataSet;
+    procedure SetDataSet(const Value: TDataSet);
+    procedure SetBuildProjectName(const Value: string);
+
+  public
+    property DataSet: TDataSet read GetDataSet write SetDataSet;
+    property Project: TObject read FProject write FProject;
+    property BuildProjectName: string read FBuildProjectName write SetBuildProjectName;
+  end;
+
+implementation
+
+{$R *.dfm}
+
+uses
+  ScProjectManager;
+
+{ TBidAliasForm }
+
+function TBidAliasForm.GetDataSet: TDataSet;
+begin
+  Result := zaBidLot.DataSet;
+end;
+
+procedure TBidAliasForm.SetDataSet(const Value: TDataSet);
+begin
+  zaBidLot.DataSet := Value;
+end;
+
+procedure TBidAliasForm.zgBidLotMouseDown(Sender: TObject;
+  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+begin
+  ldeShortName.Text := zaBidLot.DataSet['AliasName'];
+  StatusBar1.Panels[1].Text := '标段: ' + zaBidLot.DataSet['ProjName'];
+  StatusBar1.Panels[2].Text := '简称: ' + zaBidLot.DataSet['AliasName'];
+end;
+
+procedure TBidAliasForm.btnAlterClick(Sender: TObject);
+begin
+  zaBidLot.DataSet.Edit;
+  zaBidLot.DataSet['AliasName'] := ldeShortName.Text;
+  zaBidLot.DataSet.Post;
+end;
+
+procedure TBidAliasForm.btnSaveClick(Sender: TObject);
+begin
+  TProject(FProject).Save(False);
+end;
+
+procedure TBidAliasForm.zgBidLotCellTextChanging(Sender: TObject;
+  const ACoord: TPoint; var NewValue: String; var Accept: Boolean);
+begin
+  if ACoord.Y >= TZJGrid(Sender).FixedRowCount + zaBidLot.DataSet.RecordCount then
+    Accept := False;
+end;
+
+procedure TBidAliasForm.SetBuildProjectName(const Value: string);
+begin
+  FBuildProjectName := Value;
+  StatusBar1.Panels[0].Text := '建设项目: ' + FBuildProjectName;
+end;
+
+procedure TBidAliasForm.zaBidLotGridRowMoved(Sender: TObject;
+  const ACoord: TPoint; ADist: Integer; ADir: TZjMoveDirection);
+begin
+  ldeShortName.Text := zaBidLot.DataSet['AliasName'];
+  StatusBar1.Panels[1].Text := '标段: ' + zaBidLot.DataSet['ProjName'];
+  StatusBar1.Panels[2].Text := '简称: ' + zaBidLot.DataSet['AliasName'];
+end;
+
+procedure TBidAliasForm.FormShow(Sender: TObject);
+begin
+  if zaBidLot.DataSet.RecordCount > 0 then
+  begin
+    ldeShortName.Text := zaBidLot.DataSet['AliasName'];
+    StatusBar1.Panels[1].Text := '标段: ' + zaBidLot.DataSet['ProjName'];
+    StatusBar1.Panels[2].Text := '简称: ' + zaBidLot.DataSet['AliasName'];
+  end;
+end;
+
+end.

+ 107 - 0
AF/CheckPosForm.dfm

@@ -0,0 +1,107 @@
+object CheckPosFrm: TCheckPosFrm
+  Left = 525
+  Top = 283
+  BorderIcons = [biSystemMenu]
+  BorderStyle = bsSingle
+  Caption = #36873#25321#25554#20837#20301#32622
+  ClientHeight = 132
+  ClientWidth = 290
+  Color = clBtnFace
+  Font.Charset = ANSI_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -12
+  Font.Name = #23435#20307
+  Font.Style = []
+  OldCreateOrder = False
+  Position = poScreenCenter
+  DesignSize = (
+    290
+    132)
+  PixelsPerInch = 96
+  TextHeight = 12
+  object btnOK: TButton
+    Left = 150
+    Top = 101
+    Width = 65
+    Height = 23
+    Anchors = [akRight, akBottom]
+    Caption = #30830#23450
+    Default = True
+    ModalResult = 1
+    TabOrder = 0
+  end
+  object btnCancel: TButton
+    Left = 216
+    Top = 101
+    Width = 65
+    Height = 23
+    Anchors = [akRight, akBottom]
+    Cancel = True
+    Caption = #21462#28040
+    TabOrder = 1
+    OnClick = btnCancelClick
+  end
+  object rgSelectPos: TRadioGroup
+    Left = 10
+    Top = 3
+    Width = 271
+    Height = 59
+    Caption = #20301#32622
+    Columns = 2
+    Font.Charset = ANSI_CHARSET
+    Font.Color = clBlack
+    Font.Height = -12
+    Font.Name = #23435#20307
+    Font.Style = []
+    ItemIndex = 0
+    Items.Strings = (
+      #20316#20026#21518#39033#25554#20837'       '
+      #20316#20026#21069#39033#25554#20837
+      #20316#20026#23376#39033#25554#20837'      '
+      #20165#31896#36148#25991#26412)
+    ParentFont = False
+    TabOrder = 2
+  end
+  object GroupBox1: TGroupBox
+    Left = 10
+    Top = 68
+    Width = 133
+    Height = 58
+    Caption = #28165#38646
+    Font.Charset = ANSI_CHARSET
+    Font.Color = clBlack
+    Font.Height = -12
+    Font.Name = #23435#20307
+    Font.Style = []
+    ParentFont = False
+    TabOrder = 3
+    object cbBillsQty: TCheckBox
+      Left = 13
+      Top = 15
+      Width = 86
+      Height = 17
+      Caption = #28165#21333#24037#31243#37327
+      Font.Charset = ANSI_CHARSET
+      Font.Color = clBlack
+      Font.Height = -12
+      Font.Name = #23435#20307
+      Font.Style = []
+      ParentFont = False
+      TabOrder = 0
+    end
+    object cbDQQty: TCheckBox
+      Left = 13
+      Top = 36
+      Width = 82
+      Height = 17
+      Caption = #22270#32440#24037#31243#37327
+      Font.Charset = ANSI_CHARSET
+      Font.Color = clBlack
+      Font.Height = -12
+      Font.Name = #23435#20307
+      Font.Style = []
+      ParentFont = False
+      TabOrder = 1
+    end
+  end
+end

+ 58 - 0
AF/CheckPosForm.pas

@@ -0,0 +1,58 @@
+unit CheckPosForm;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, StdCtrls, ExtCtrls, ImgList, dximctrl;
+
+type
+  TCheckPosFrm = class(TForm)
+    btnOK: TButton;
+    btnCancel: TButton;
+    rgSelectPos: TRadioGroup;
+    GroupBox1: TGroupBox;
+    cbBillsQty: TCheckBox;
+    cbDQQty: TCheckBox;
+    procedure btnCancelClick(Sender: TObject);
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+  end;
+
+function CheckBillsPastePosition(var ABillsQty, ADQQty: Boolean; aPasteText: Boolean = False): Integer;
+
+implementation
+
+{$R *.dfm}
+
+uses ConstVarUnit;
+
+procedure TCheckPosFrm.btnCancelClick(Sender: TObject);
+begin
+  Close;
+end;
+
+function CheckBillsPastePosition(var ABillsQty, ADQQty: Boolean; aPasteText: Boolean): Integer;
+var
+  checkPosForm: TCheckPosFrm;
+begin
+  Result := -1;
+  checkPosForm := TCheckPosFrm.Create(nil);
+  if not aPasteText then
+    checkPosForm.rgSelectPos.Items.Delete(3)
+  else
+    checkPosForm.cbDQQty.Enabled := False;
+
+  if checkPosForm.ShowModal = mrOK then
+  begin
+    Result := checkPosForm.rgSelectPos.ItemIndex;
+    ABillsQty := checkPosForm.cbBillsQty.Checked;
+    ADQQty := checkPosForm.cbDQQty.Checked;
+  end;
+  checkPosForm.Free;
+  Application.ProcessMessages;
+end;
+
+end.

Разница между файлами не показана из-за своего большого размера
+ 1081 - 0
AF/Common/FlashForm.dfm


+ 22 - 0
AF/Common/FlashForm.pas

@@ -0,0 +1,22 @@
+unit FlashForm;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, jpeg, ExtCtrls;
+
+type
+  TflashFrm = class(TForm)
+    Image1: TImage;
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+  end;
+
+implementation
+
+{$R *.dfm}
+
+end.

Разница между файлами не показана из-за своего большого размера
+ 1658 - 0
AF/ExportExFrm.dfm


+ 302 - 0
AF/ExportExFrm.pas

@@ -0,0 +1,302 @@
+unit ExportExFrm;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, ExtCtrls, StdCtrls, CheckLst, ImgList, dximctrl, ActnList,
+  ComCtrls, ToolWin;
+
+type
+  TExportExForm = class(TForm)
+    Panel1: TPanel;
+    btnOK: TButton;
+    btnCancel: TButton;
+    Panel2: TPanel;
+    Label1: TLabel;
+    Splitter1: TSplitter;
+    Panel3: TPanel;
+    Label2: TLabel;
+    clbProjectBills: TCheckListBox;
+    lbBidLot: TListBox;
+    imgsSmall: TImageList;
+    ActionList: TActionList;
+    actnUpMove: TAction;
+    actnDownMove: TAction;
+    ToolBar1: TToolBar;
+    ToolButton3: TToolButton;
+    ToolButton1: TToolButton;
+    ToolButton2: TToolButton;
+    labMergeOptions: TLabel;
+    rbMergeOptions: TGroupBox;
+    rdbtnCodeName: TRadioButton;
+    rdbtnCode: TRadioButton;
+    procedure FormCreate(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+    procedure clbProjectBillsClick(Sender: TObject);
+    procedure btnCancelClick(Sender: TObject);
+    procedure actnUpMoveExecute(Sender: TObject);
+    procedure actnDownMoveExecute(Sender: TObject);
+    procedure actnUpMoveUpdate(Sender: TObject);
+    procedure actnDownMoveUpdate(Sender: TObject);
+  private
+    { Private declarations }
+    FStrings: TStrings;
+    FExportEx: Boolean;
+    function GetStringsIdx(aIdx: Integer): Integer;
+    function IsMergeByCode: Boolean;
+  public
+    { Public declarations }
+    procedure InitForMergeProject(const aBuildProject: string);
+    procedure InitForSelectExcel;
+  end;
+
+{ Export Excel }
+function ExportExForm(aBidLots, aProjectBills: TStrings): Boolean;
+{ Gather Project }
+function SelectProjectForm(aProjectList: TStrings; const aBuildProject: string; var MergeByCode: Boolean): Boolean;
+{ TODO : 导入Excel }
+function SelectExcelSheet(aCaptions: TStrings): Boolean;
+
+implementation
+
+{$R *.dfm}
+
+function ExportExForm(aBidLots, aProjectBills: TStrings): Boolean;
+var
+  I, J: Integer;
+  sFullName: string;
+  ExportExForm: TExportExForm;
+begin
+  ExportExForm := TExportExForm.Create(nil);
+  try
+    for I := 0 to aBidLots.Count - 1 do
+    begin
+      sFullName := string(aBidLots.Objects[I]);
+      ExportExForm.lbBidLot.Items.AddObject(aBidLots[I], Pointer(sFullName){aBidLots.Objects[I]});
+      Integer(sFullName) := 0;
+    end;
+
+    for I := 0 to aProjectBills.Count - 1 do
+    begin
+      sFullName := string(aProjectBills.Objects[I]);
+      ExportExForm.clbProjectBills.Items.AddObject(aProjectBills[I], Pointer(sFullName){aProjectBills.Objects[I]});
+      Integer(sFullName) := 0;
+    end;
+
+    ExportExForm.FExportEx := True;
+    ExportExForm.lbBidLot.ItemIndex := 0;
+    if ExportExForm.ShowModal = mrOk then
+    begin
+      for I := 0 to aBidLots.Count - 1 do
+      begin
+        aBidLots[I] := '1';
+      end;
+
+      J := 1;
+      for I := 0 to ExportExForm.FStrings.Count - 1 do
+      begin
+        if ExportExForm.FStrings[I] <> '' then
+        begin
+          aBidLots.InsertObject(J, '2', Pointer(ExportExForm.FStrings[I]));
+          Inc(J, 2);
+        end
+        else
+          Inc(J, 3);
+      end;
+      Result := True;
+    end
+    else Result := False;
+  finally
+    ExportExForm.Free;
+  end;
+end;
+
+function SelectProjectForm(aProjectList: TStrings; const aBuildProject: string;
+  var MergeByCode: Boolean): Boolean;
+var
+  I: Integer;
+  sProject: string;
+  ProjectsForm: TExportExForm;
+begin
+  Result := False;
+  ProjectsForm := TExportExForm.Create(nil);
+  try
+    ProjectsForm.InitForMergeProject(aBuildProject);
+
+    for I := 0 to aProjectList.Count - 1 do
+    begin
+      sProject := string(aProjectList.Objects[I]);
+      ProjectsForm.clbProjectBills.Items.AddObject(aProjectList[I], Pointer(sProject));
+      Integer(sProject) := 0;
+    end;
+
+    if ProjectsForm.ShowModal = mrOK then
+    begin
+      aProjectList.Clear;
+      MergeByCode := ProjectsForm.IsMergeByCode;
+      for I := 0 to ProjectsForm.clbProjectBills.Count - 1 do
+      begin
+        if ProjectsForm.clbProjectBills.Checked[I] then
+        begin
+          sProject := string(ProjectsForm.clbProjectBills.Items.Objects[I]);
+          aProjectList.Add(sProject);
+          Integer(sProject) := 0;
+        end;
+      end;
+      Result := True;
+    end;
+  finally
+    ProjectsForm.Free;
+  end;
+end;
+
+function SelectExcelSheet(aCaptions: TStrings): Boolean;
+var
+  I: Integer;
+  sProject: string;
+  ProjectsForm: TExportExForm;
+begin
+  Result := False;
+  ProjectsForm := TExportExForm.Create(nil);
+  try
+    ProjectsForm.InitForSelectExcel;
+
+    for I := 0 to aCaptions.Count - 1 do
+      ProjectsForm.clbProjectBills.Items.AddObject(aCaptions[I], aCaptions.Objects[I]);
+
+    if ProjectsForm.ShowModal = mrOK then
+    begin
+      aCaptions.Clear;
+      for I := 0 to ProjectsForm.clbProjectBills.Count - 1 do
+      begin
+        if ProjectsForm.clbProjectBills.Checked[I] then
+          aCaptions.AddObject(ProjectsForm.clbProjectBills.Items[I], ProjectsForm.clbProjectBills.Items.Objects[I]);
+      end;
+      Result := True;
+    end;
+  finally
+    ProjectsForm.Free;
+  end;
+end;
+
+procedure TExportExForm.FormCreate(Sender: TObject);
+begin
+  FStrings := TStringList.Create;
+end;
+
+procedure TExportExForm.FormDestroy(Sender: TObject);
+begin
+  FStrings.Free;
+end;
+
+function TExportExForm.GetStringsIdx(aIdx: Integer): Integer;
+var
+  I, iBidIdx: Integer;
+begin
+  Result := -1;
+  for I := 0 to FStrings.Count - 1 do
+  begin
+    iBidIdx := Integer(FStrings.Objects[I]);
+    if iBidIdx = aIdx then
+    begin
+      Result := I;
+      Break;
+    end;
+  end;
+end;
+
+procedure TExportExForm.clbProjectBillsClick(Sender: TObject);
+var
+  I, iIdx: Integer;
+begin
+  if not FExportEx then Exit;
+  iIdx := GetStringsIdx(lbBidLot.ItemIndex);
+  if clbProjectBills.Checked[clbProjectBills.ItemIndex] then
+  begin
+    if iIdx = -1 then
+    begin
+      FStrings.AddObject(string(clbProjectBills.Items.Objects[clbProjectBills.ItemIndex]),
+                         Pointer(lbBidLot.ItemIndex));
+    end
+    else
+    begin
+      FStrings[iIdx] := string(clbProjectBills.Items.Objects[clbProjectBills.ItemIndex]);
+    end;
+
+    for I := 0 to clbProjectBills.Count - 1 do
+    begin
+      if I <> clbProjectBills.ItemIndex then
+        clbProjectBills.Checked[I] := False;
+    end;
+  end
+  else
+  begin
+    if iIdx <> -1 then
+      FStrings[iIdx] := '';
+  end;
+end;
+
+procedure TExportExForm.btnCancelClick(Sender: TObject);
+begin
+  Close;
+end;
+
+procedure TExportExForm.InitForMergeProject(const aBuildProject: string);
+begin
+  Caption := '建设项目 - [' + aBuildProject + ']';
+  Width := 450;
+  Height := 380;
+  Panel2.Visible := False;
+  Label2.Caption := '标段分项清单:';
+  FExportEx := False;
+  rbMergeOptions.Visible := True;
+  labMergeOptions.Visible := True;
+end;
+
+procedure TExportExForm.InitForSelectExcel;
+begin
+  Caption := '导入Excel文件';
+  Width := 450;
+  Height := 380;
+  Panel2.Visible := False;
+  Label2.Caption := '选择工作表:';
+  FExportEx := False;
+end;
+
+procedure TExportExForm.actnUpMoveExecute(Sender: TObject);
+var
+  iIndex: Integer;
+begin
+  iIndex := clbProjectBills.ItemIndex;
+  clbProjectBills.Items.Exchange(iIndex, iIndex - 1);
+end;
+
+procedure TExportExForm.actnDownMoveExecute(Sender: TObject);
+var
+  iIndex: Integer;
+begin
+  iIndex := clbProjectBills.ItemIndex;
+  clbProjectBills.Items.Exchange(iIndex, iIndex + 1);
+end;
+
+procedure TExportExForm.actnUpMoveUpdate(Sender: TObject);
+begin
+  actnUpMove.Enabled := clbProjectBills.ItemIndex > 0;
+end;
+
+procedure TExportExForm.actnDownMoveUpdate(Sender: TObject);
+begin
+  actnDownMove.Enabled := (clbProjectBills.Items.Count > 1) and
+    (clbProjectBills.ItemIndex < clbProjectBills.Items.Count - 1);
+end;
+
+function TExportExForm.IsMergeByCode: Boolean;
+begin
+  if rdbtnCodeName.Checked then
+    Result := False
+  else
+    Result := True;
+end;
+
+end.

BIN
AF/FlashForm.ddp


Разница между файлами не показана из-за своего большого размера
+ 3316 - 0
AF/FlashForm.dfm


+ 22 - 0
AF/FlashForm.pas

@@ -0,0 +1,22 @@
+unit FlashForm;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, jpeg, ExtCtrls;
+
+type
+  TflashFrm = class(TForm)
+    Image1: TImage;
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+  end;
+
+implementation
+
+{$R *.dfm}
+
+end.

+ 131 - 0
AF/NewProjectFrm.dfm

@@ -0,0 +1,131 @@
+object NewProjectForm: TNewProjectForm
+  Left = 347
+  Top = 267
+  BorderIcons = [biSystemMenu]
+  BorderStyle = bsSingle
+  Caption = #26032#24314#39033#30446
+  ClientHeight = 126
+  ClientWidth = 370
+  Color = clBtnFace
+  Font.Charset = ANSI_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -12
+  Font.Name = #23435#20307
+  Font.Style = []
+  OldCreateOrder = False
+  Position = poScreenCenter
+  OnCloseQuery = FormCloseQuery
+  DesignSize = (
+    370
+    126)
+  PixelsPerInch = 96
+  TextHeight = 12
+  object Label1: TLabel
+    Left = 12
+    Top = 52
+    Width = 84
+    Height = 12
+    Caption = #25152#23646#24314#35774#39033#30446#65306
+  end
+  object ldeProjectName: TLabeledEdit
+    Left = 11
+    Top = 28
+    Width = 339
+    Height = 20
+    EditLabel.Width = 60
+    EditLabel.Height = 12
+    EditLabel.Caption = #26631#27573#21517#31216#65306
+    TabOrder = 0
+    OnChange = ldeProjectNameChange
+  end
+  object GroupBox1: TGroupBox
+    Left = 219
+    Top = 325
+    Width = 167
+    Height = 78
+    Caption = #20998#31867
+    TabOrder = 1
+    object cbGatherProject: TCheckBox
+      Left = 12
+      Top = 25
+      Width = 69
+      Height = 17
+      Caption = #24314#35774#39033#30446
+      TabOrder = 0
+      OnClick = cbGatherProjectClick
+    end
+    object cbBidLotProject: TCheckBox
+      Left = 11
+      Top = 51
+      Width = 107
+      Height = 17
+      Caption = #26631#27573'('#20998#39033#28165#21333')'
+      Checked = True
+      State = cbChecked
+      TabOrder = 1
+      OnClick = cbBidLotProjectClick
+    end
+  end
+  object btnCreate: TButton
+    Left = 202
+    Top = 93
+    Width = 70
+    Height = 23
+    Anchors = [akRight, akBottom]
+    Caption = #21019#24314
+    Default = True
+    ModalResult = 6
+    TabOrder = 2
+  end
+  object btnClose: TButton
+    Left = 281
+    Top = 93
+    Width = 70
+    Height = 23
+    Anchors = [akRight, akBottom]
+    Cancel = True
+    Caption = #20851#38381
+    TabOrder = 3
+    OnClick = btnCloseClick
+  end
+  object GroupBox2: TGroupBox
+    Left = -168
+    Top = 92
+    Width = 167
+    Height = 78
+    Caption = #31867#22411
+    TabOrder = 4
+    object cbEstimate: TCheckBox
+      Left = 12
+      Top = 49
+      Width = 52
+      Height = 17
+      Caption = #20915#31639
+      Enabled = False
+      TabOrder = 0
+      Visible = False
+      OnClick = cbEstimateClick
+    end
+    object cbBillsBudget: TCheckBox
+      Left = 12
+      Top = 22
+      Width = 101
+      Height = 17
+      Caption = #28165#21333#39044#31639
+      Checked = True
+      Enabled = False
+      State = cbChecked
+      TabOrder = 1
+      OnClick = cbBillsBudgetClick
+    end
+  end
+  object cbbProjList: TComboBox
+    Left = 11
+    Top = 68
+    Width = 342
+    Height = 20
+    Style = csDropDownList
+    ItemHeight = 12
+    TabOrder = 5
+  end
+end

+ 293 - 0
AF/NewProjectFrm.pas

@@ -0,0 +1,293 @@
+unit NewProjectFrm;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants,
+  Classes, Graphics, Controls, Forms,
+  Dialogs, StdCtrls, ExtCtrls,
+  ConstMethodUnit, ConstVarUnit,
+  ConstTypeUnit;
+
+type
+  TNewProjectForm = class(TForm)
+    ldeProjectName: TLabeledEdit;
+    GroupBox1: TGroupBox;
+    btnCreate: TButton;
+    btnClose: TButton;
+    cbGatherProject: TCheckBox;
+    cbBidLotProject: TCheckBox;
+    GroupBox2: TGroupBox;
+    cbEstimate: TCheckBox;
+    cbBillsBudget: TCheckBox;
+    Label1: TLabel;
+    cbbProjList: TComboBox;
+    procedure btnCloseClick(Sender: TObject);
+    procedure cbBillsBudgetClick(Sender: TObject);
+    procedure cbEstimateClick(Sender: TObject);
+    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
+    procedure cbGatherProjectClick(Sender: TObject);
+    procedure cbBidLotProjectClick(Sender: TObject);
+    procedure ldeProjectNameChange(Sender: TObject);
+  private
+    FProjectName: string;
+
+    function GetProjectName: string;
+    function GetProjectType: Integer;
+    function GetProjectKind: Integer;
+    function GetProjectGatherID: Integer;
+    procedure SetProjectType(const Value: Integer);
+    procedure SetProjectName(const Value: string);
+    {}
+    procedure InitProjList(aProjList: TStrings; aCurIdx: Integer);
+    procedure DisabledBuildProject;
+
+    { FX lib }
+    procedure InputLibView(aFormType: TFormType);
+    function GetFileFlag: Integer;
+    property FileFlag: Integer read GetFileFlag;
+
+    property ProjectName: string read GetProjectName write SetProjectName;
+    property ProjectType: Integer read GetProjectType write SetProjectType;
+    property ProjectKind: Integer read GetProjectKind;
+    property ProjectGatherID: Integer read GetProjectGatherID;
+  public
+
+  end;
+
+function NewProjectInfo(aProjList: TStrings; var aProjName: string;
+  var aProjType, aProjKind, aGatherID: Integer; aCurIdx: Integer = -1): Boolean;
+
+{ TODO : Import FXQD }
+
+function InputStdLibName(var aLibName: string; var aFileFlag: Integer;
+  aFormType: TFormType = ftImportStdLib): Boolean;
+
+
+implementation
+
+{$R *.dfm}
+
+function NewProjectInfo(aProjList: TStrings;
+  var aProjName: string;
+  var aProjType, aProjKind, aGatherID: Integer;
+  aCurIdx: Integer): Boolean;
+var
+  NewProjectForm: TNewProjectForm;
+begin
+  NewProjectForm := TNewProjectForm.Create(nil);
+  try
+    if Assigned(aProjList) then
+      if aProjList.Count = 0 then
+      begin
+        Result := False;
+        ShowMessage('项目文件不存在, 请先创建项目文件!');
+        Exit;
+      end
+      else
+        NewProjectForm.InitProjList(aProjList, aCurIdx)
+    else
+    begin
+      // 以前处理方法,如不存在项目文件,则创建
+      NewProjectForm.DisabledBuildProject;
+    end;
+
+    NewProjectForm.ProjectName := aProjName;
+    NewProjectForm.ProjectType := aProjType;
+    Result := NewProjectForm.ShowModal = mrYes;
+    if Result then
+    begin
+      aProjName := NewProjectForm.ProjectName;
+      aProjType := NewProjectForm.ProjectType;
+      aProjKind := NewProjectForm.ProjectKind;
+      if Assigned(aProjList) then
+        aGatherID := NewProjectForm.ProjectGatherID;
+    end;
+  finally
+    NewProjectForm.Free;
+  end;
+end;
+
+function InputStdLibName(var aLibName: string; var aFileFlag: Integer; aFormType: TFormType): Boolean;
+var
+  NewProjectForm: TNewProjectForm;
+begin
+  NewProjectForm := TNewProjectForm.Create(nil);
+
+  try
+    NewProjectForm.ldeProjectName.Text := aLibName;
+    NewProjectForm.InputLibView(aFormType);
+    Result := NewProjectForm.ShowModal = mrYes;
+    if Result then
+    begin
+      aLibName := NewProjectForm.ldeProjectName.Text;
+      aFileFlag := NewProjectForm.FileFlag;
+    end;
+  finally
+    NewProjectForm.Free;
+  end;
+
+end;
+
+procedure TNewProjectForm.btnCloseClick(Sender: TObject);
+begin
+  Close;
+end;
+
+procedure TNewProjectForm.cbBillsBudgetClick(Sender: TObject);
+begin
+  cbEstimate.Checked := not cbBillsBudget.Checked;
+end;
+
+procedure TNewProjectForm.cbEstimateClick(Sender: TObject);
+begin
+  cbBillsBudget.Checked := not cbEstimate.Checked;
+end;
+
+function TNewProjectForm.GetProjectName: string;
+begin
+  Result := ldeProjectName.Text;
+end;
+
+function TNewProjectForm.GetProjectType: Integer;
+begin
+  if cbBillsBudget.Checked then
+    Result := 5
+  else
+    Result := 6;
+end;
+
+procedure TNewProjectForm.SetProjectType(const Value: Integer);
+begin
+  cbBillsBudget.Checked := Value = 5;
+end;
+
+procedure TNewProjectForm.FormCloseQuery(Sender: TObject;
+  var CanClose: Boolean);
+begin
+  if ModalResult <> mrYes then Exit;
+  if ProjectName = '' then
+  begin
+    MessageWarning(0, sNameNotNull);
+    CanClose := False;
+    Exit;
+  end;
+
+  if CheckFileExists(ProjectName) then
+  begin
+    MessageWarning(0, sSameFileName);
+    CanClose := False;
+    Exit;
+  end;
+end;
+
+procedure TNewProjectForm.SetProjectName(const Value: string);
+begin
+  ldeProjectName.Text := Value;
+end;
+
+procedure TNewProjectForm.cbGatherProjectClick(Sender: TObject);
+begin
+  cbBidLotProject.Checked := not cbGatherProject.Checked;
+  Label1.Enabled := False;
+  cbbProjList.Enabled := False;
+end;
+
+procedure TNewProjectForm.cbBidLotProjectClick(Sender: TObject);
+begin
+  cbGatherProject.Checked := not cbBidLotProject.Checked;
+  Label1.Enabled := True;
+  cbbProjList.Enabled := True;
+end;
+
+function TNewProjectForm.GetProjectKind: Integer;
+begin
+  if cbGatherProject.Checked then
+    Result := 1
+  else
+    Result := 2;
+end;
+
+procedure TNewProjectForm.InitProjList(aProjList: TStrings; aCurIdx: Integer);
+var
+  I: Integer;
+begin
+  if aProjList.Count = 0 then
+  begin
+    { TODO : 如果建设项目没有,则只能创建新建设项目,不可以创建标段 [litao 2011.7.4] }
+    cbGatherProject.Checked := True;
+    DisabledBuildProject;
+    Exit;
+  end;
+
+  for I := 0 to aProjList.Count - 1 do
+  begin
+    cbbProjList.Items.AddObject(aProjList[I], aProjList.Objects[I]);
+  end;
+  cbbProjList.ItemIndex := aCurIdx;
+end;
+
+function TNewProjectForm.GetProjectGatherID: Integer;
+begin
+  Result := 0;
+  if cbbProjList.ItemIndex = -1 then Exit;
+  Result := Integer(cbbProjList.Items.Objects[cbbProjList.ItemIndex]);
+end;
+
+procedure TNewProjectForm.DisabledBuildProject;
+begin
+  Label1.Enabled := False;
+  cbbProjList.Enabled := False;
+  cbGatherProject.Enabled := False;
+  cbBidLotProject.Enabled := False;
+end;
+
+procedure TNewProjectForm.ldeProjectNameChange(Sender: TObject);
+begin
+  if CheckSpecialChar(TLabeledEdit(Sender).Text) then
+  begin
+    MessageWarning(0, sSpecialChar);
+    TLabeledEdit(Sender).Text := FProjectName;
+    TLabeledEdit(Sender).SelStart := Length(FProjectName);
+  end
+  else
+    FProjectName := TLabeledEdit(Sender).Text;
+end;
+
+procedure TNewProjectForm.InputLibView(aFormType: TFormType);
+begin
+  Caption := '导入';
+
+  Label1.Visible := False;
+  cbbProjList.Visible := False;
+
+  GroupBox2.Visible := False;
+  GroupBox1.Width := ldeProjectName.Width;
+  GroupBox1.Top := 60;
+  // Maixinrong 2012-03-26 类型框错位了
+  GroupBox1.Left := ldeProjectName.Left;
+
+  if aFormType = ftImportStdLib then
+  begin
+    cbGatherProject.Checked := True;
+    ldeProjectName.EditLabel.Caption := '名称:';
+    cbBidLotProject.Visible := False;
+    cbGatherProject.Caption := '分项清单';
+    cbBidLotProject.Caption := '工程量清单';
+  end;
+
+  btnCreate.Caption := '确定';
+
+  Height := 210;
+  OnCloseQuery := nil;
+end;
+
+function TNewProjectForm.GetFileFlag: Integer;
+begin
+  if cbGatherProject.Checked then
+    Result := 1
+  else
+    Result := 2;
+end;
+
+end.

+ 816 - 0
AF/RecycleBinFrm.dfm

@@ -0,0 +1,816 @@
+object RecycleBinForm: TRecycleBinForm
+  Left = 356
+  Top = 275
+  BorderStyle = bsSingle
+  Caption = #33410#28857#22238#25910#31449
+  ClientHeight = 313
+  ClientWidth = 599
+  Color = clBtnFace
+  Font.Charset = ANSI_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -12
+  Font.Name = #23435#20307
+  Font.Style = []
+  OldCreateOrder = False
+  Position = poDefault
+  WindowState = wsMaximized
+  OnShow = FormShow
+  PixelsPerInch = 96
+  TextHeight = 12
+  object Splitter1: TSplitter
+    Left = 185
+    Top = 0
+    Height = 313
+  end
+  object pnlXmjBills: TPanel
+    Left = 0
+    Top = 0
+    Width = 185
+    Height = 313
+    Align = alLeft
+    BevelOuter = bvNone
+    TabOrder = 0
+    object JimGradLabel1: TJimGradLabel
+      Left = 0
+      Top = 0
+      Width = 185
+      Height = 20
+      Align = alTop
+      AutoSize = False
+      ColorBegin = clGradientActiveCaption
+      ColorEnd = clBtnFace
+      Caption = ' '#39033#30446#33410'('#28165#21333')'
+      Font.Charset = DEFAULT_CHARSET
+      Font.Color = clWindowText
+      Font.Height = -12
+      Font.Name = 'smartSimSun'
+      Font.Style = [fsBold]
+      ParentFont = False
+      Layout = tlCenter
+    end
+    object zgXmjBills: TZJGrid
+      Left = 0
+      Top = 20
+      Width = 185
+      Height = 293
+      Options = [goRangeSelect, goRowSizing, goColSizing, goCellNotMaintainData, goFixedRowShowNo, goFixedColShowNo, goAlwaysShowSelection, goShowTreeLine]
+      OptionsEx = []
+      ShowGridLine = False
+      DefaultColWidth = 73
+      DefaultFixedColWidth = 30
+      Selection.AlphaBlend = False
+      Selection.TransparentColor = False
+      OnPaste = zgXmjBillsPaste
+      Align = alClient
+    end
+  end
+  object Panel2: TPanel
+    Left = 188
+    Top = 0
+    Width = 411
+    Height = 313
+    Align = alClient
+    BevelOuter = bvNone
+    TabOrder = 1
+    object Splitter3: TSplitter
+      Left = 0
+      Top = 190
+      Width = 411
+      Height = 3
+      Cursor = crVSplit
+      Align = alBottom
+    end
+    object pnlNodeDetailInfo: TPanel
+      Left = 0
+      Top = 193
+      Width = 411
+      Height = 120
+      Align = alBottom
+      BevelOuter = bvNone
+      TabOrder = 0
+      object Splitter2: TSplitter
+        Left = 208
+        Top = 0
+        Height = 120
+        Align = alRight
+      end
+      object pnlNodeDrawingQuantity: TPanel
+        Left = 211
+        Top = 0
+        Width = 200
+        Height = 120
+        Align = alRight
+        BevelOuter = bvNone
+        TabOrder = 0
+        object JimGradLabel4: TJimGradLabel
+          Left = 0
+          Top = 0
+          Width = 200
+          Height = 20
+          Align = alTop
+          AutoSize = False
+          ColorBegin = clGradientActiveCaption
+          ColorEnd = clBtnFace
+          Caption = ' '#35774#35745#32454#30446
+          Font.Charset = DEFAULT_CHARSET
+          Font.Color = clWindowText
+          Font.Height = -12
+          Font.Name = 'smartSimSun'
+          Font.Style = [fsBold]
+          ParentFont = False
+          Layout = tlCenter
+        end
+        object zgNodeDrawingQuantity: TZJGrid
+          Left = 0
+          Top = 20
+          Width = 200
+          Height = 100
+          Options = [goRangeSelect, goRowSizing, goColSizing, goCellNotMaintainData, goFixedRowShowNo, goFixedColShowNo, goAlwaysShowSelection]
+          OptionsEx = []
+          ShowGridLine = False
+          DefaultColWidth = 73
+          DefaultFixedColWidth = 25
+          Selection.AlphaBlend = False
+          Selection.TransparentColor = False
+          Align = alClient
+        end
+      end
+      object Panel7: TPanel
+        Left = 0
+        Top = 0
+        Width = 208
+        Height = 120
+        Align = alClient
+        BevelOuter = bvNone
+        TabOrder = 1
+        object JimGradLabel3: TJimGradLabel
+          Left = 0
+          Top = 0
+          Width = 208
+          Height = 20
+          Align = alTop
+          AutoSize = False
+          ColorBegin = clGradientActiveCaption
+          ColorEnd = clBtnFace
+          Caption = ' '#39033#30446#33410'('#28165#21333')'
+          Font.Charset = DEFAULT_CHARSET
+          Font.Color = clWindowText
+          Font.Height = -12
+          Font.Name = 'smartSimSun'
+          Font.Style = [fsBold]
+          ParentFont = False
+          Layout = tlCenter
+        end
+        object zgNodeXmjBills: TZJGrid
+          Left = 0
+          Top = 20
+          Width = 208
+          Height = 100
+          Options = [goRangeSelect, goRowSizing, goColSizing, goCellNotMaintainData, goFixedRowShowNo, goFixedColShowNo, goAlwaysShowSelection, goShowTreeLine]
+          OptionsEx = []
+          ColCount = 11
+          RowCount = 6
+          FixedRowCount = 2
+          ShowGridLine = False
+          DefaultColWidth = 73
+          DefaultFixedColWidth = 25
+          DefaultFixedRowHeight = 15
+          Selection.AlphaBlend = False
+          Selection.TransparentColor = False
+          Align = alClient
+        end
+      end
+    end
+    object pnlButtons: TPanel
+      Left = 0
+      Top = 163
+      Width = 411
+      Height = 27
+      Align = alBottom
+      BevelOuter = bvNone
+      TabOrder = 1
+      object spbtnRestore: TSpeedButton
+        Left = 2
+        Top = 2
+        Width = 90
+        Height = 23
+        Caption = #36824#21407#33410#28857
+        Glyph.Data = {
+          36040000424D3604000000000000360000002800000010000000100000000100
+          2000000000000004000000000000000000000000000000000000FF00FF00FF00
+          FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF00FFF7F700C6A58C00945A42009C52310094522900C694
+          7B00F7EFE700FFF7F700FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF005A392900945A3100B5634200C66B4200C67B5200C6734200B56B
+          4A00A5523100C6A5940073634A00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF008C5A4A00A55A3100E78C6300FF9C7300F7B59C00BD7B5A00F7CEB500F7A5
+          7B00D68C6300944A2100C6AD9C00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00A5634200F78C6300F79C6300F7CEB500FF00FF00FF00FF00FF00FF00FFFF
+          F700FFAD8400C67B63008C523100E7DED600FF00FF00FF00FF00FF00FF00F7D6
+          BD00E7845200D684630094634A00E7EFE70052845200316331004A734A00D6DE
+          D600FFF7EF00EF946B00A5633900D6BDB500FF00FF00FF00FF00FF00FF00FFAD
+          7300C66B4200CE947B00FF00FF007B847B0042A5310031942100217B21004A73
+          3900FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FFA5
+          7300B5633100CEAD9C00FFF7F7005A73520042D6420031BD310021942100396B
+          3100FF00FF00F7C6AD00E78C63009C5A3900FF00FF00FF00FF00FFFFF700FFB5
+          8C00C6735200C6947B00FF00FF007B846B0063DE630042D6420031B531003963
+          3100FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FFFFF700FFC6
+          A500E78C52009C634A00C69C8C00FF00FF0084947300C65A31007B847300A594
+          8400FF00FF00F7B59400E7947300F7EFE700FF00FF00FF00FF00FF00FF00FFE7
+          DE00F79C6300D67B520094523100E7D6CE00F7E7E700B5634200B56B4200E7CE
+          C600FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FFFF
+          F700FFC6A500F79C6300D67B5200A55A3100B55A3100C66B4200B55A3100B56B
+          4200F7D6CE00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FFEFE700FFBD9C00FF9C7300F79C6300F7A57300FFA57300E78C5200E794
+          6300D67B5200FFE7DE00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FFF7EF00FFDECE00FFB58400F79C7300FFB59400F7B59400E78C
+          5A00EFDED600FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF00FF00FF00FFFFFF00F7DED600F7AD8400E7946300FFEF
+          E700FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF00FF00FF00FF00FF00FFFFF700F7AD8C00F7D6C600FF00
+          FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00}
+        OnClick = spbtnRestoreClick
+      end
+      object spbtnDelete: TSpeedButton
+        Left = 93
+        Top = 2
+        Width = 90
+        Height = 23
+        Caption = #21024#38500#33410#28857
+        Glyph.Data = {
+          36040000424D3604000000000000360000002800000010000000100000000100
+          2000000000000004000000000000000000000000000000000000FF00FF00FF00
+          FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00D6D6D6006B736B00BDBDBD00EFEFEF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF00FF00FF00EFEFEF00FF00FF00FF00FF00FF00FF00FF00
+          FF00848C840010101000525252008CB59400FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF00948C8C00D6D6D600FF00FF00FF00FF00FF00FF00FF00
+          FF00BDBDBD002118100031292100295A290052AD6300FF00FF00FF00FF00FF00
+          FF00FF00FF00E7E7E70039423900E7E7E700FF00FF00FF00FF00FF00FF00FF00
+          FF00DEE7DE00294A3100212121003142310031944A00FF00FF00FF00FF00F7F7
+          F700F7EFF7005252520084848400FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF0039B55A0029423100212121003952420042AD63009CC6A500F7F7
+          F7008484840039393900E7E7E700FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF008CD69C00524A420031292100395A4200319442005A63
+          5A0031313100A5A59C00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF00FF00FF00E7E7E700524A420031313100313131004239
+          310042394200FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF00FF00FF00FF00FF00CECECE0031313100423942003142
+          310052A56300FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF00FF00FF00DEDEDE006363630042393100393939003139
+          31003152310073B58400FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF00ADADAD00424242004242420094949400DEDEDE008C8C
+          8C0042424200316B420084BD8C00FF00FF00FF00FF00FF00FF00FF00FF00E7E7
+          E700CECECE007B7B7B00424242004242420084848400F7F7F700FF00FF00F7F7
+          F700847B7B0042424200316B4200C6DECE00FF00FF00FF00FF00FF00FF00B5B5
+          B5007B7B7B004239310042424200A5A5A500FF00FF00FF00FF00FF00FF00FF00
+          FF00F7F7F700C6CEC600525252005A736300FF00FF00FF00FF00FF00FF00B5BD
+          B500424242004A4A4A00CEC6CE00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF00EFEFEF00ADADAD00FF00FF00FF00FF00FF00FF00DEDE
+          DE007B737B00D6D6D600FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00}
+        OnClick = spbtnDeleteClick
+      end
+      object spbtnExitBin: TSpeedButton
+        Left = 275
+        Top = 2
+        Width = 90
+        Height = 23
+        Caption = #36864#20986#22238#25910#31449
+        Glyph.Data = {
+          36040000424D3604000000000000360000002800000010000000100000000100
+          2000000000000004000000000000000000000000000000000000FF00FF00FF00
+          FF00FF00FF00FF00FF00FF00FF0084848400FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF005A4A31001810100010425200FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF0084736B00425A6300106B94002984A500FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF006373730084A5
+          B5004284A50021A5D60042ADE700217BA5001010210010102100FF00FF00FF00
+          FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00738C9400A5DE
+          F70063D6FF0052C6F70031ADE7001084B500E7DED60010212100FF00FF00FF00
+          FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00738C9400B5EF
+          F70084E7FF0063CEF70052BDF700108CC600F7DED60021293100FF00FF00FF00
+          FF0073524200944A2100FF00FF00FF00FF00FF00FF00FF00FF00848C9400B5EF
+          F70084E7FF0063D6FF00424252001094C600F7E7D60031394200FF00FF00EFCE
+          BD00A5523100A5522100FF00FF00FF00FF00FF00FF00FF00FF008494A500C6F7
+          FF0094E7FF0073DEFF0063CEF7000094C600F7E7E70042425200AD735200A552
+          3100D67B4200B55A3100A5522100A54A2100944A2100944A21008494A500C6F7
+          FF00A5EFFF0084DEFF0073D6F70042B5E700F7EFE70063525200A55A3100E78C
+          6300F7946300F78C5200E77B5200D6734200B56B4200944A2100849CA500C6F7
+          FF00A5EFFF0094EFFF0084E7FF0084BDD600F7EFE700E79C7300FFC6A500FFB5
+          9400FFA57300F7946300F78C5200E77B5200D6734200A5522100849CA500C6F7
+          FF00C6FFFF00A5E7F70094ADB500C6CED600F7F7E70094848400F7A57300FFC6
+          A500FFB59400FFB59400FFAD8400F7A58400E79C7300B552310094A5A500E7FF
+          FF00B5CED60094A5B500F7F7F700FFFFF700F7F7F70063738400E7C6B500F7A5
+          7300FFC6A500D66B3100E79C7300E7946300E78C6300E784520094A5B50094AD
+          B500C6CED600FFFFFF00FFFFFF00FFFFFF00FFFFFF00738C9400FF00FF00F7DE
+          D600E79C7300D6734200FF00FF00FF00FF00FF00FF00FF00FF0094A5B50094A5
+          B50094A5B50094A5B50094A5A500849CA500849CA500949CA500FF00FF00FF00
+          FF00E7C6B500E79C7300FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00}
+        OnClick = spbtnExitBinClick
+      end
+      object spbtnClear: TSpeedButton
+        Left = 184
+        Top = 2
+        Width = 90
+        Height = 23
+        Caption = #28165#31354#22238#25910#31449
+        Glyph.Data = {
+          36040000424D3604000000000000360000002800000010000000100000000100
+          2000000000000004000000000000000000000000000000000000FF00FF00FF00
+          FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00D6D6D6006B736B00BDBDBD00EFEFEF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF00FF00FF00EFEFEF00FF00FF00FF00FF00FF00FF00FF00
+          FF00848C840010101000525252008CB59400FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF00948C8C00D6D6D600FF00FF00FF00FF00FF00FF00FF00
+          FF00BDBDBD002118100031292100295A290052AD6300FF00FF00FF00FF00FF00
+          FF00FF00FF00E7E7E70039423900E7E7E700FF00FF00FF00FF00FF00FF00FF00
+          FF00DEE7DE00294A3100212121003142310031944A00FF00FF00FF00FF00F7F7
+          F700F7EFF7005252520084848400FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF0039B55A0029423100212121003952420042AD63009CC6A500F7F7
+          F7008484840039393900E7E7E700FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF008CD69C00524A420031292100395A4200319442005A63
+          5A0031313100A5A59C00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF00FF00FF00E7E7E700524A420031313100313131004239
+          310042394200FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF00FF00FF00FF00FF00CECECE0031313100423942003142
+          310052A56300FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF00FF00FF00DEDEDE006363630042393100393939003139
+          31003152310073B58400FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF00ADADAD00424242004242420094949400DEDEDE008C8C
+          8C0042424200316B420084BD8C00FF00FF00FF00FF00FF00FF00FF00FF00E7E7
+          E700CECECE007B7B7B00424242004242420084848400F7F7F700FF00FF00F7F7
+          F700847B7B0042424200316B4200C6DECE00FF00FF00FF00FF00FF00FF00B5B5
+          B5007B7B7B004239310042424200A5A5A500FF00FF00FF00FF00FF00FF00FF00
+          FF00F7F7F700C6CEC600525252005A736300FF00FF00FF00FF00FF00FF00B5BD
+          B500424242004A4A4A00CEC6CE00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF00EFEFEF00ADADAD00FF00FF00FF00FF00FF00FF00DEDE
+          DE007B737B00D6D6D600FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
+          FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00}
+        OnClick = spbtnClearClick
+      end
+    end
+    object Panel5: TPanel
+      Left = 0
+      Top = 0
+      Width = 411
+      Height = 163
+      Align = alClient
+      BevelOuter = bvNone
+      TabOrder = 2
+      object JimGradLabel2: TJimGradLabel
+        Left = 0
+        Top = 0
+        Width = 411
+        Height = 20
+        Align = alTop
+        AutoSize = False
+        ColorBegin = clGradientActiveCaption
+        ColorEnd = clBtnFace
+        Caption = ' '#22238#25910#31449#33410#28857
+        Font.Charset = DEFAULT_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -12
+        Font.Name = 'smartSimSun'
+        Font.Style = [fsBold]
+        ParentFont = False
+        Layout = tlCenter
+      end
+      object zgBinNode: TZJGrid
+        Left = 0
+        Top = 20
+        Width = 411
+        Height = 143
+        Options = [goRangeSelect, goRowSizing, goColSizing, goCellNotMaintainData, goFixedRowShowNo, goFixedColShowNo, goAlwaysShowSelection]
+        OptionsEx = []
+        ColCount = 3
+        ShowGridLine = False
+        DefaultColWidth = 73
+        DefaultFixedColWidth = 25
+        Selection.AlphaBlend = False
+        Selection.TransparentColor = False
+        Align = alClient
+      end
+    end
+  end
+  object ztaNodeXmjBills: TZjGridTreeDBA
+    Columns = <
+      item
+        Title.Caption = #32534#21495
+        Title.CaptionAcrossCols = '1'
+        Title.CaptionAcrossRows = 2
+        Title.Font.Charset = GB2312_CHARSET
+        Title.Font.Color = clWindowText
+        Title.Font.Height = -12
+        Title.Font.Name = #23435#20307
+        Title.Font.Style = []
+        Alignment = taLeftJustify
+        Font.Charset = GB2312_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -12
+        Font.Name = #23435#20307
+        Font.Style = []
+        FieldName = 'Code'
+        Width = 150
+        ReadOnly = True
+      end
+      item
+        Title.Caption = #21517#31216
+        Title.CaptionAcrossCols = '1'
+        Title.CaptionAcrossRows = 2
+        Title.Font.Charset = GB2312_CHARSET
+        Title.Font.Color = clWindowText
+        Title.Font.Height = -12
+        Title.Font.Name = #23435#20307
+        Title.Font.Style = []
+        Alignment = taLeftJustify
+        Font.Charset = GB2312_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -12
+        Font.Name = #23435#20307
+        Font.Style = []
+        FieldName = 'Name'
+        ReadOnly = True
+      end
+      item
+        Title.Caption = #21333#20301
+        Title.CaptionAcrossCols = '1'
+        Title.CaptionAcrossRows = 2
+        Title.Font.Charset = GB2312_CHARSET
+        Title.Font.Color = clWindowText
+        Title.Font.Height = -12
+        Title.Font.Name = #23435#20307
+        Title.Font.Style = []
+        Alignment = taCenter
+        Font.Charset = GB2312_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -12
+        Font.Name = #23435#20307
+        Font.Style = []
+        FieldName = 'Units'
+        Width = 50
+        ReadOnly = True
+      end
+      item
+        Title.Caption = #24037#31243#37327
+        Title.CaptionAcrossCols = '1'
+        Title.CaptionAcrossRows = 2
+        Title.Font.Charset = GB2312_CHARSET
+        Title.Font.Color = clWindowText
+        Title.Font.Height = -12
+        Title.Font.Name = #23435#20307
+        Title.Font.Style = []
+        Alignment = taRightJustify
+        Font.Charset = GB2312_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -12
+        Font.Name = #23435#20307
+        Font.Style = []
+        FieldName = 'Quantity'
+        Width = 60
+        ReadOnly = True
+      end
+      item
+        Title.Caption = #35774#35745#25968#37327'|'#25968#37327'1'
+        Title.CaptionAcrossCols = '2'
+        Title.Font.Charset = GB2312_CHARSET
+        Title.Font.Color = clWindowText
+        Title.Font.Height = -12
+        Title.Font.Name = #23435#20307
+        Title.Font.Style = []
+        Alignment = taRightJustify
+        Font.Charset = GB2312_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -12
+        Font.Name = #23435#20307
+        Font.Style = []
+        FieldName = 'DesignQuantity'
+        Width = 60
+        ReadOnly = True
+      end
+      item
+        Title.Caption = '|'#25968#37327'2'
+        Title.CaptionAcrossCols = '1'
+        Title.Font.Charset = GB2312_CHARSET
+        Title.Font.Color = clWindowText
+        Title.Font.Height = -12
+        Title.Font.Name = #23435#20307
+        Title.Font.Style = []
+        Alignment = taRightJustify
+        Font.Charset = GB2312_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -12
+        Font.Name = #23435#20307
+        Font.Style = []
+        FieldName = 'DesignQuantity2'
+        Width = 60
+        ReadOnly = True
+      end
+      item
+        Title.Caption = #21333#20215
+        Title.CaptionAcrossCols = '1'
+        Title.CaptionAcrossRows = 2
+        Title.Font.Charset = GB2312_CHARSET
+        Title.Font.Color = clWindowText
+        Title.Font.Height = -12
+        Title.Font.Name = #23435#20307
+        Title.Font.Style = []
+        Alignment = taRightJustify
+        Font.Charset = GB2312_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -12
+        Font.Name = #23435#20307
+        Font.Style = []
+        FieldName = 'UnitPrice'
+        Width = 60
+        ReadOnly = True
+      end
+      item
+        Title.Caption = #32463#27982#25351#26631
+        Title.CaptionAcrossCols = '1'
+        Title.CaptionAcrossRows = 2
+        Title.Font.Charset = GB2312_CHARSET
+        Title.Font.Color = clWindowText
+        Title.Font.Height = -12
+        Title.Font.Name = #23435#20307
+        Title.Font.Style = []
+        Alignment = taRightJustify
+        Font.Charset = GB2312_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -12
+        Font.Name = #23435#20307
+        Font.Style = []
+        FieldName = 'DesignPrice'
+        Width = 60
+        ReadOnly = True
+      end
+      item
+        Title.Caption = #37329#39069
+        Title.CaptionAcrossCols = '1'
+        Title.CaptionAcrossRows = 2
+        Title.Font.Charset = GB2312_CHARSET
+        Title.Font.Color = clWindowText
+        Title.Font.Height = -12
+        Title.Font.Name = #23435#20307
+        Title.Font.Style = []
+        Alignment = taRightJustify
+        Font.Charset = GB2312_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -12
+        Font.Name = #23435#20307
+        Font.Style = []
+        FieldName = 'TotalPrice'
+        Width = 60
+        ReadOnly = True
+      end
+      item
+        Title.Caption = #22791#27880
+        Title.CaptionAcrossCols = '1'
+        Title.CaptionAcrossRows = 2
+        Title.Font.Charset = GB2312_CHARSET
+        Title.Font.Color = clWindowText
+        Title.Font.Height = -12
+        Title.Font.Name = #23435#20307
+        Title.Font.Style = []
+        Alignment = taLeftJustify
+        Font.Charset = GB2312_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -12
+        Font.Name = #23435#20307
+        Font.Style = []
+        FieldName = 'MemoStr'
+        ReadOnly = True
+      end>
+    Grid = zgNodeXmjBills
+    AutoExpand = False
+    KeyFieldName = 'ID'
+    ParentFieldName = 'ParentID'
+    NextSiblingFieldName = 'NextSiblingID'
+    Left = 280
+    Top = 244
+  end
+  object zaBinNode: TZjGridDBA
+    Columns = <
+      item
+        Title.Caption = #21517#31216
+        Title.CaptionAcrossCols = '1'
+        Title.Font.Charset = GB2312_CHARSET
+        Title.Font.Color = clWindowText
+        Title.Font.Height = -12
+        Title.Font.Name = #23435#20307
+        Title.Font.Style = []
+        Alignment = taLeftJustify
+        Font.Charset = GB2312_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -12
+        Font.Name = #23435#20307
+        Font.Style = []
+        FieldName = 'Name'
+        Width = 220
+        ReadOnly = True
+      end
+      item
+        Title.Caption = #21019#24314#26102#38388
+        Title.CaptionAcrossCols = '1'
+        Title.Font.Charset = GB2312_CHARSET
+        Title.Font.Color = clWindowText
+        Title.Font.Height = -12
+        Title.Font.Name = #23435#20307
+        Title.Font.Style = []
+        Alignment = taLeftJustify
+        Font.Charset = GB2312_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -12
+        Font.Name = #23435#20307
+        Font.Style = []
+        FieldName = 'CreateTime'
+        Width = 190
+        ReadOnly = True
+      end>
+    Grid = zgBinNode
+    Left = 372
+    Top = 100
+  end
+  object ztaXmjBills: TZjGridTreeDBA
+    Columns = <
+      item
+        Title.Caption = #39033#30446#33410#32534#21495
+        Title.CaptionAcrossCols = '1'
+        Title.Font.Charset = GB2312_CHARSET
+        Title.Font.Color = clWindowText
+        Title.Font.Height = -12
+        Title.Font.Name = #23435#20307
+        Title.Font.Style = []
+        Alignment = taLeftJustify
+        Font.Charset = GB2312_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -12
+        Font.Name = #23435#20307
+        Font.Style = []
+        FieldName = 'Code'
+        Width = 200
+        ReadOnly = True
+      end
+      item
+        Title.Caption = #28165#21333#32534#21495
+        Title.CaptionAcrossCols = '1'
+        Title.Font.Charset = GB2312_CHARSET
+        Title.Font.Color = clWindowText
+        Title.Font.Height = -12
+        Title.Font.Name = #23435#20307
+        Title.Font.Style = []
+        Alignment = taLeftJustify
+        Font.Charset = GB2312_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -12
+        Font.Name = #23435#20307
+        Font.Style = []
+        FieldName = 'B_Code'
+        Width = 80
+        ReadOnly = True
+      end
+      item
+        Title.Caption = #21517#31216
+        Title.CaptionAcrossCols = '1'
+        Title.Font.Charset = GB2312_CHARSET
+        Title.Font.Color = clWindowText
+        Title.Font.Height = -12
+        Title.Font.Name = #23435#20307
+        Title.Font.Style = []
+        Alignment = taLeftJustify
+        Font.Charset = GB2312_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -12
+        Font.Name = #23435#20307
+        Font.Style = []
+        FieldName = 'Name'
+        Width = 120
+        ReadOnly = True
+      end
+      item
+        Title.Caption = #21333#20301
+        Title.CaptionAcrossCols = '1'
+        Title.Font.Charset = GB2312_CHARSET
+        Title.Font.Color = clWindowText
+        Title.Font.Height = -12
+        Title.Font.Name = #23435#20307
+        Title.Font.Style = []
+        Alignment = taCenter
+        Font.Charset = GB2312_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -12
+        Font.Name = #23435#20307
+        Font.Style = []
+        FieldName = 'Units'
+        Width = 50
+        ReadOnly = True
+      end>
+    Grid = zgXmjBills
+    AutoExpand = False
+    KeyFieldName = 'ID'
+    ParentFieldName = 'ParentID'
+    NextSiblingFieldName = 'NextSiblingID'
+    Left = 85
+    Top = 88
+  end
+  object zaNodeDrawingQuantity: TZjGridDBA
+    Columns = <
+      item
+        Title.Caption = #21517#31216
+        Title.CaptionAcrossCols = '1'
+        Title.Font.Charset = GB2312_CHARSET
+        Title.Font.Color = clWindowText
+        Title.Font.Height = -12
+        Title.Font.Name = #23435#20307
+        Title.Font.Style = []
+        Alignment = taLeftJustify
+        Font.Charset = GB2312_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -12
+        Font.Name = #23435#20307
+        Font.Style = []
+        FieldName = 'Name'
+        ReadOnly = True
+      end
+      item
+        Title.Caption = #21333#20301
+        Title.CaptionAcrossCols = '1'
+        Title.Font.Charset = GB2312_CHARSET
+        Title.Font.Color = clWindowText
+        Title.Font.Height = -12
+        Title.Font.Name = #23435#20307
+        Title.Font.Style = []
+        Alignment = taCenter
+        Font.Charset = GB2312_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -12
+        Font.Name = #23435#20307
+        Font.Style = []
+        FieldName = 'Units'
+        Width = 50
+        ReadOnly = True
+      end
+      item
+        Title.Caption = #35774#35745#25968#37327
+        Title.CaptionAcrossCols = '1'
+        Title.Font.Charset = GB2312_CHARSET
+        Title.Font.Color = clWindowText
+        Title.Font.Height = -12
+        Title.Font.Name = #23435#20307
+        Title.Font.Style = []
+        Alignment = taRightJustify
+        Font.Charset = GB2312_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -12
+        Font.Name = #23435#20307
+        Font.Style = []
+        FieldName = 'DQuantity1'
+        Width = 60
+        ReadOnly = True
+      end
+      item
+        Title.Caption = #22791#27880
+        Title.CaptionAcrossCols = '1'
+        Title.Font.Charset = GB2312_CHARSET
+        Title.Font.Color = clWindowText
+        Title.Font.Height = -12
+        Title.Font.Name = #23435#20307
+        Title.Font.Style = []
+        Alignment = taLeftJustify
+        Font.Charset = GB2312_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -12
+        Font.Name = #23435#20307
+        Font.Style = []
+        FieldName = 'MemoContext'
+        ReadOnly = True
+      end>
+    Grid = zgNodeDrawingQuantity
+    Left = 453
+    Top = 240
+  end
+  object ActionList: TActionList
+    Left = 324
+    Top = 100
+    object ZjGridPaste: TZjGridPaste
+      Category = 'ZjGridDBA'
+      Caption = 'ZjGridPaste'
+    end
+    object ZjDbaDelete: TZjDbaDelete
+      Category = 'ZjGridDBA'
+      Caption = 'ZjDbaDelete'
+    end
+  end
+end

+ 119 - 0
AF/RecycleBinFrm.pas

@@ -0,0 +1,119 @@
+unit RecycleBinFrm;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, Buttons, ZjGridDBA, ZjGridTreeDBA, ZJGrid, StdCtrls, JimLabels,
+  ExtCtrls, ScProjectManager, ScCopyBills, ZjDbaActns, ActnList;
+
+type
+  TRecycleBinForm = class(TForm)
+    pnlXmjBills: TPanel;
+    Splitter1: TSplitter;
+    Panel2: TPanel;
+    pnlNodeDetailInfo: TPanel;
+    pnlButtons: TPanel;
+    Panel5: TPanel;
+    JimGradLabel1: TJimGradLabel;
+    JimGradLabel2: TJimGradLabel;
+    zgXmjBills: TZJGrid;
+    ztaNodeXmjBills: TZjGridTreeDBA;
+    zgBinNode: TZJGrid;
+    spbtnRestore: TSpeedButton;
+    spbtnDelete: TSpeedButton;
+    pnlNodeDrawingQuantity: TPanel;
+    Panel7: TPanel;
+    Splitter2: TSplitter;
+    JimGradLabel3: TJimGradLabel;
+    JimGradLabel4: TJimGradLabel;
+    zgNodeXmjBills: TZJGrid;
+    zgNodeDrawingQuantity: TZJGrid;
+    zaBinNode: TZjGridDBA;
+    ztaXmjBills: TZjGridTreeDBA;
+    zaNodeDrawingQuantity: TZjGridDBA;
+    Splitter3: TSplitter;
+    spbtnExitBin: TSpeedButton;
+    ActionList: TActionList;
+    ZjGridPaste: TZjGridPaste;
+    ZjDbaDelete: TZjDbaDelete;
+    spbtnClear: TSpeedButton;
+    procedure FormShow(Sender: TObject);
+    procedure spbtnExitBinClick(Sender: TObject);
+    procedure zgXmjBillsPaste(Sender: TObject; const ABounds: TRect;
+      var Allow: Boolean);
+    procedure spbtnRestoreClick(Sender: TObject);
+    procedure spbtnDeleteClick(Sender: TObject);
+    procedure spbtnClearClick(Sender: TObject);
+  private
+    FProject: TProject;
+    procedure InitFormView;
+    procedure SetProject(const Value: TProject);
+
+  public
+    property Project: TProject read FProject write SetProject;
+  end;
+
+implementation
+
+uses RecycleBinDM;
+
+{$R *.dfm}
+
+{ TRecycleBinForm }
+
+procedure TRecycleBinForm.InitFormView;
+begin
+  pnlXmjBills.Width := 510;
+  pnlNodeDetailInfo.Height := 200;
+  pnlNodeDrawingQuantity.Width := 350;
+end;
+
+procedure TRecycleBinForm.FormShow(Sender: TObject);
+begin
+  InitFormView;
+end;
+
+procedure TRecycleBinForm.spbtnExitBinClick(Sender: TObject);
+begin
+  Close;
+end;
+
+procedure TRecycleBinForm.zgXmjBillsPaste(Sender: TObject;
+  const ABounds: TRect; var Allow: Boolean);
+begin
+  with TScXMLClipboard.Create(FProject.BillsData) do
+  try
+    PasteBillsFromFile(FProject.RecycleBinData.GetCurrentFileName, ABounds.Top - TZjGrid(Sender).FixedRowCount);
+  finally
+    Free;
+  end;
+end;
+
+procedure TRecycleBinForm.SetProject(const Value: TProject);
+begin
+  FProject := Value;
+  FProject.RecycleBinData.RefreshBills;
+  ztaXmjBills.IDTree := FProject.BillsData.BillsTree;
+  zaBinNode.DataSet := FProject.RecycleBinData.cdsRecycleBin;
+  ztaNodeXmjBills.IDTree := FProject.RecycleBinData.BillsTree;
+  zaNodeDrawingQuantity.DataSet := FProject.RecycleBinData.cdsDrawingQuantity;
+end;
+
+procedure TRecycleBinForm.spbtnRestoreClick(Sender: TObject);
+begin
+  zgXmjBills.PasteFromClipboard(zgXmjBills.Selection.Bounds);
+  FProject.RecycleBinData.DeleteCurrentNode;
+end;
+
+procedure TRecycleBinForm.spbtnDeleteClick(Sender: TObject);
+begin
+  FProject.RecycleBinData.DeleteCurrentNode;
+end;
+
+procedure TRecycleBinForm.spbtnClearClick(Sender: TObject);
+begin
+  FProject.RecycleBinData.ClearNodes;
+end;
+
+end.

Разница между файлами не показана из-за своего большого размера
+ 1060 - 0
AF/ScAuthFrm.dfm


+ 294 - 0
AF/ScAuthFrm.pas

@@ -0,0 +1,294 @@
+unit ScAuthFrm;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, StdCtrls, ExtCtrls, jpeg;
+
+type
+  TAuthorizeForm = class(TForm)
+    nbMain: TNotebook;
+    btnPrev: TButton;
+    btnNext: TButton;
+    btnCancel: TButton;
+    Label1: TLabel;
+    Panel1: TPanel;
+    Memo1: TMemo;
+    Label4: TLabel;
+    gbManual: TGroupBox;
+    rbManual: TRadioButton;
+    gbAuthFile: TGroupBox;
+    rbAuthFile: TRadioButton;
+    btnBrowseAuthFile: TButton;
+    OpenDialog1: TOpenDialog;
+    leAuthorize: TLabeledEdit;
+    leAuthFile: TLabeledEdit;
+    Image1: TImage;
+    mmFinish: TMemo;
+    Image2: TImage;
+    Label3: TLabel;
+    Label7: TLabel;
+    Label2: TLabel;
+    leHaspID: TLabeledEdit;
+    lblPhone: TLabel;
+    Label5: TLabel;
+    Label6: TLabel;
+    Label8: TLabel;
+    Label9: TLabel;
+    Panel3: TPanel;
+    Image3: TImage;
+    Label10: TLabel;
+    lblHint: TLabel;
+    Panel2: TPanel;
+    procedure FormCreate(Sender: TObject);
+    procedure btnCancelClick(Sender: TObject);
+    procedure nbMainPageChanged(Sender: TObject);
+    procedure btnPrevClick(Sender: TObject);
+    procedure btnNextClick(Sender: TObject);
+    procedure rbAuthFileClick(Sender: TObject);
+    procedure rbManualClick(Sender: TObject);
+    procedure btnBrowseAuthFileClick(Sender: TObject);
+    procedure Label9MouseEnter(Sender: TObject);
+    procedure Label9MouseLeave(Sender: TObject);
+    procedure Label9Click(Sender: TObject);
+  private
+    { Private declarations }
+    procedure InternalAuthorize(AFile: string);
+    procedure InternalAuthorizeByText(AKey: string);
+    // 0 正确;-1 错误; -2 损坏
+    function CheckAuthorizeFile(AFile: string): Integer;
+  public
+    { Public declarations }
+  end;
+
+function Authorize: Boolean;
+
+implementation
+
+uses
+  ScUtils, ScEncryptUnit, CryptUtils, ScHaspPwd, ShellAPI;
+
+{$R *.dfm}
+
+function Authorize: Boolean;
+var
+  Form: TAuthorizeForm;
+begin
+  {$IFDEF _ScNet}
+  {$ELSE}
+  if bAuthorized then
+  begin
+    MessageHint(0, '本产品已注册。'#13#10'产品序列号为:' + strHaspID);
+    Exit;
+  end;
+  Form := TAuthorizeForm.Create(nil);
+  try
+    Result := Form.ShowModal = mrOK;
+  finally
+    Form.Free;
+  end;
+  {$ENDIF}
+end;
+
+const
+  strWelcome = '尊敬的用户:'#13#10#13#10 +
+
+               '    感谢您购买《纵横SmartCost工程造价管理系统》!'#13#10#13#10 +
+
+               '    您现在可以开始使用本系统,为了保障您的权益,客服中心将有专人与您联系,以完成产品的注册。'#13#10#13#10 +
+
+               '    在完成注册前,本产品可以正常使用50次或200小时,在这段时间内,若未完成注册,请查询“帮助->产品注册”菜单,以完成注册,或咨询客服中心。'#13#10#13#10#13#10#13#10 +
+
+               '    点击“下一步”开始注册。';
+  strSuccess = '恭喜您!您已经注册成功!'#13#10#13#10'请重新运行程序即可正常使用软件。';
+  strFailed = '注册失败,请确认您的软件合法性,以及产品编号的正确性。'#13#10#13#10'详情请咨询客服中心。';
+
+procedure TAuthorizeForm.FormCreate(Sender: TObject);
+begin
+  nbMain.PageIndex := 0;
+  Memo1.Lines.Clear;
+  Memo1.Text := Format(strWelcome, [LoadAuthorizePhone]);
+  lblPhone.Caption := LoadAuthorizePhone;
+  leHaspID.Text := strHaspID;
+end;
+
+procedure TAuthorizeForm.btnCancelClick(Sender: TObject);
+begin
+  ModalResult := mrCancel;
+  Close;
+end;
+
+procedure TAuthorizeForm.nbMainPageChanged(Sender: TObject);
+begin
+  if nbMain.PageIndex = 0 then
+    btnPrev.Enabled := False
+  else
+    btnPrev.Enabled := True;
+  if nbMain.PageIndex = nbMain.Pages.Count - 1 then
+  begin
+    btnPrev.Enabled := False;
+    btnNext.Enabled := True;
+    btnNext.Caption := '完成(&O)';
+    btnCancel.Enabled := False;
+  end;
+  case nbMain.PageIndex of
+    0:
+      lblHint.Caption := '产品注册概述';
+    1:
+      lblHint.Caption := '注册方式提示';
+    2:
+      lblHint.Caption := '进行注册';
+    3:
+      lblHint.Caption := '完成注册';
+  end;
+end;
+
+procedure TAuthorizeForm.btnPrevClick(Sender: TObject);
+begin
+  nbMain.PageIndex := nbMain.PageIndex - 1;
+end;
+
+procedure TAuthorizeForm.btnNextClick(Sender: TObject);
+begin
+  case nbMain.PageIndex of
+    2:
+    begin
+      if rbAuthFile.Checked then
+      begin
+        if not FileExists(leAuthFile.Text) then
+        begin
+          MessageHint(0, '指定的注册文件不存在,请重新选择。');
+          Exit;
+        end
+        else if CheckAuthorizeFile(leAuthFile.Text) < 0 then
+        begin
+          MessageHint(0, '指定的注册文件不是有效的SmartCost注册文件,请重新选择。');
+          Exit;
+        end;
+        InternalAuthorize(leAuthFile.Text);
+      end
+      else if rbManual.Checked then
+      begin
+        if leAuthorize.Text = '' then
+        begin
+          MessageHint(0, '请输入注册码。');
+          Exit;
+        end;
+        InternalAuthorizeByText(leAuthorize.Text);
+      end;
+      if bAuthorized then
+      begin
+        mmFinish.Text := strSuccess;
+        Image1.Visible := True;
+        Image2.Visible := False;
+      end
+      else
+      begin
+        mmFinish.Text := strFailed;
+        Image1.Visible := False;
+        Image2.Visible := True;
+      end;
+    end;
+    3:
+    begin
+      ModalResult := mrOK;
+      Close;
+    end;
+  end;
+  nbMain.PageIndex := nbMain.PageIndex + 1;
+end;
+
+procedure TAuthorizeForm.rbAuthFileClick(Sender: TObject);
+begin
+  rbManual.Checked := False;
+  leAuthFile.Enabled := True;
+  btnBrowseAuthFile.Enabled := True;
+  leAuthorize.Enabled := False;
+  leAuthFile.SetFocus;
+end;
+
+procedure TAuthorizeForm.rbManualClick(Sender: TObject);
+begin
+  rbAuthFile.Checked := False;
+  leAuthFile.Enabled := False;
+  btnBrowseAuthFile.Enabled := False;
+  leAuthorize.Enabled := True;
+  leAuthorize.SetFocus;
+end;
+
+procedure TAuthorizeForm.InternalAuthorize(AFile: string);
+var
+  Key: array [0..1023] of Byte;
+  fsFile: TFileStream;
+begin
+  fsFile := TFileStream.Create(AFile, fmOpenRead);
+  try
+    fsFile.Read(Key, fsFile.Size);
+  finally
+    fsFile.Free;
+  end;
+
+  UserAuthorize(Key);
+end;
+
+procedure TAuthorizeForm.btnBrowseAuthFileClick(Sender: TObject);
+begin
+  if OpenDialog1.Execute then
+    leAuthFile.Text := OpenDialog1.FileName;
+end;
+
+function TAuthorizeForm.CheckAuthorizeFile(AFile: string): Integer;
+var
+  fsFile: TFileStream;
+  rFile: PAuthorizeFile;
+begin
+{  fsFile := TFileStream.Create(AFile, fmOpenRead);
+  New(rFile);
+  ZeroMemory(rFile, SizeOf(TAuthorizeFile));
+  try
+    fsFile.Read(rFile^, SizeOf(TAuthorizeFile));
+    if SameText(rFile.Head, HASP_AuthorizeFileHead) then
+      Result := 1
+    else
+      Result := -1;
+  finally
+    Dispose(rFile);
+    fsFile.Free;
+  end;
+//}  Result := 1;
+end;
+
+procedure TAuthorizeForm.InternalAuthorizeByText(AKey: string);
+var
+  Key: array [0..1023] of Byte;
+  fsFile: TFileStream;
+  I: Integer;
+begin
+//  if Length(AKey) <> Length_AuthorizeFile * 2 then
+//    Exit;
+  for I := 0 to (Length(AKey) div 2 - 1) do
+  begin
+    Key[I] := StrToInt('$' + AKey[2 * I + 1] + AKey[2 * I + 2]);
+  end;
+  UserAuthorize(Key);
+end;
+
+procedure TAuthorizeForm.Label9MouseEnter(Sender: TObject);
+begin
+  TLabel(Sender).Font.Color := clHighLight;
+  Screen.Cursor := crHandPoint;
+end;
+
+procedure TAuthorizeForm.Label9MouseLeave(Sender: TObject);
+begin
+  TLabel(Sender).Font.Color := clHotLight;
+  Screen.Cursor := crDefault;
+end;
+
+procedure TAuthorizeForm.Label9Click(Sender: TObject);
+begin
+  Shellexecute(Handle, 'open', PChar(Format('mailto:"纵横产品注册中心"<support@smartcost.com.cn>?subject=SmartCost注册,序列号[%s]', [strHaspID])), 'SmartCost软件锁注册', '', SW_SHOW);
+end;
+
+end.

BIN
AF/ScLicenseCodeFrm.dfm


+ 70 - 0
AF/ScLicenseCodeFrm.pas

@@ -0,0 +1,70 @@
+unit ScLicenseCodeFrm;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, StdCtrls, ExtCtrls;
+
+type
+  TLicenseCodeForm = class(TForm)
+    btnCancel: TButton;
+    Edit1: TEdit;
+    Label1: TLabel;
+    btnOk: TButton;
+    procedure btnOkClick(Sender: TObject);
+    procedure btnCancelClick(Sender: TObject);
+
+  private
+    procedure Init(ACode: string);
+  public
+    { Public declarations }
+  end;
+
+function ShowLicenseCode(ACode: string): Boolean;
+{var
+  Form2: TLicenseCodeForm; }
+
+implementation
+
+{$R *.dfm}
+
+function ShowLicenseCode(ACode: string): Boolean;
+var
+  Form: TLicenseCodeForm;
+begin
+  Form := TLicenseCodeForm.Create(nil);
+  try
+    Form.Init(ACode);
+    if Form.ShowModal = mrOk then
+      Result := True;
+  finally
+    Form.Free;
+  end;
+end;
+
+
+
+{ TLicenseCodeForm }
+
+procedure TLicenseCodeForm.Init(ACode: string);
+begin
+  Label1.Caption := '您的申请已经成功提交,请记录您的授权码。' + #13#10 +
+    '第一次登录网络版时,需输入授权码,请您妥善保管!' + #13#10 +
+      '是否复制授权码?';
+  Edit1.Text := ACode;
+end;
+
+procedure TLicenseCodeForm.btnOkClick(Sender: TObject);
+begin
+  Edit1.SelectAll;
+  Edit1.CopyToClipboard;
+  ModalResult := mrOk;
+end;
+
+procedure TLicenseCodeForm.btnCancelClick(Sender: TObject);
+begin
+  ModalResult := mrCancel;
+end;
+
+end.

Разница между файлами не показана из-за своего большого размера
+ 11568 - 0
AF/ScLoginFrm.dfm


+ 145 - 0
AF/ScLoginFrm.pas

@@ -0,0 +1,145 @@
+unit ScLoginFrm;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, JimCombos, ExtCtrls, StdCtrls, cxLookAndFeelPainters,
+  cxTextEdit, cxButtons, cxControls, cxEdit,
+  cxMaskEdit, cxDropDownEdit, HookEdit, cxContainer, XPMenu, cslLabel;
+
+type
+  TLoginFrm = class(TForm)
+    Image1: TImage;
+    Label3: TLabel;
+    cxcbServers: TcxComboBox;
+    cxbRequest: TcxButton;
+    cxbLogin: TcxButton;
+    GroupBox1: TGroupBox;
+    Label1: TLabel;
+    Label2: TLabel;
+    cxeUserName: TcxTextEdit;
+    edtPassword: TEdit;
+    XPMenu1: TXPMenu;
+    lblBBS: TLabel;
+    Label4: TLabel;
+    Label5: TLabel;
+    Label6: TLabel;
+    Label7: TLabel;
+    cslLabel1: TcslLabel;
+    cslLabel2: TcslLabel;
+    cxbExit: TcxButton;
+    chkRememberUser: TCheckBox;
+    cxb1: TcxButton;
+    procedure cxbRequestClick(Sender: TObject);
+    procedure edtPasswordEnter(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+    procedure lblBBSClick(Sender: TObject);
+    procedure cxbExitClick(Sender: TObject);
+    procedure chkRememberUserClick(Sender: TObject);
+    procedure cxb1Click(Sender: TObject);
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+  end;
+
+  function ShowLoginForm(var AUserName, APW: string): Boolean;
+
+implementation
+
+uses
+  ScClientDM, ScUtils, ShellAPI, IniFiles;
+
+{$R *.dfm}
+
+type
+  TEditAccess = class(TcxCustomTextEdit);
+
+// chenshilong, 2011-05-13 10:21:54
+function ShowLoginForm(var AUserName, APW: string): Boolean;
+var
+  Form: TLoginFrm;
+begin
+  Result := False;
+  Form := TLoginFrm.Create(nil);
+  try
+    // 第一次使用弹出注册窗口
+//    if UserConfigInfo.FirstLogon then
+//      ClientData.InputUserInfo;
+
+    AUserName := UserConfigInfo.UserName;
+    APW := UserConfigInfo.PassWord;
+
+    Form.cxeUserName.Text := UserConfigInfo.UserName;
+    Form.edtPassword.Text := UserConfigInfo.PassWord;
+    Form.chkRememberUser.Checked := UserConfigInfo.RememberUser;
+
+    if Form.ShowModal = mrOK then
+    begin
+      // lengshumei 2010-8-11
+      if APW <> '' then
+        SetEncryptEdit(Form.edtPassword);
+
+      AUserName := Trim(Form.cxeUserName.Text);
+      APW := GetEncryptEditText(Form.edtPassword);
+      DisableHookEdit;
+      Result := True;
+      // 登录成功,要修改状态,免得下次还会显示注册界面
+//      if UserConfigInfo.FirstLogon then
+//      begin
+//        UserConfigInfo.FirstLogon := False;
+//        UserConfigInfo.SaveToFile;
+//      end;
+    end;
+  finally
+    Form.Free;
+  end;
+end;
+
+{ TLoginFrm }
+
+// chenshilong, 2011-05-13 8:58:11 即日起不再有注册码。
+procedure TLoginFrm.cxbRequestClick(Sender: TObject);
+begin
+{  if ClientData.InputUserInfo then
+    if MessageQuest(0, '您的申请已经成功提交,请稍后登录纵横软件论坛,查看您的授权码。' +
+      #13#10 + '现在登录纵横软件论坛请点击“确定”,否则请点“取消”。') = IDOK then
+      ShellExecute(0, nil, 'http://www.smartcost.com.cn/bbs', nil, nil, SW_SHOWNORMAL);  }
+
+  ClientData.InputUserInfo;
+end;
+
+procedure TLoginFrm.edtPasswordEnter(Sender: TObject);
+begin
+  //edtPassword.Clear;
+  //SetEncryptEdit(edtPassword);
+  SetEncryptEdit(TEdit(Sender));
+end;
+
+procedure TLoginFrm.FormDestroy(Sender: TObject);
+begin
+  RemoveEncryptEdit(edtPassword);
+end;
+
+procedure TLoginFrm.lblBBSClick(Sender: TObject);
+begin
+  ShellExecute(0, nil, 'http://bbs.smartcost.com.cn', nil, nil, SW_SHOWNORMAL);
+end;
+
+procedure TLoginFrm.cxbExitClick(Sender: TObject);
+begin
+  Close;
+end;
+
+procedure TLoginFrm.chkRememberUserClick(Sender: TObject);
+begin
+  UserConfigInfo.RememberUserInfo(chkRememberUser.Checked);
+end;
+
+procedure TLoginFrm.cxb1Click(Sender: TObject);
+begin
+  ClientData.ChangePWDBeforeLogin;
+end;
+
+end.

Разница между файлами не показана из-за своего большого размера
+ 11403 - 0
AF/ScModifyPwdFrm.dfm


+ 227 - 0
AF/ScModifyPwdFrm.pas

@@ -0,0 +1,227 @@
+unit ScModifyPwdFrm;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, JimCombos, ExtCtrls, StdCtrls, cxLookAndFeelPainters,
+  cxTextEdit, cxButtons, cxControls, cxEdit,
+  cxMaskEdit, cxDropDownEdit, HookEdit, cxContainer, cslLabel;
+
+type
+  TModifyPwdFrm = class(TForm)
+    Image1: TImage;
+    cxbComfirm: TcxButton;
+    GroupBox1: TGroupBox;
+    Label1: TLabel;
+    Label2: TLabel;
+    cxeUserName: TcxTextEdit;
+    edtPassword: TEdit;
+    Label3: TLabel;
+    edtNewPassword: TEdit;
+    Label4: TLabel;
+    cxbExit: TcxButton;
+    edtConfirmNewPassword: TEdit;
+    Label6: TLabel;
+    procedure edtPasswordEnter(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+    procedure edtNewPasswordEnter(Sender: TObject);
+    procedure edtConfirmNewPasswordEnter(Sender: TObject);
+    procedure cxbComfirmClick(Sender: TObject);
+    procedure cxbExitClick(Sender: TObject);
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+    function CheckData: Boolean;
+  end;
+
+  function ShowModifyPwdForm(var AUserName, APW, ANewPW1, ANewPW2: string): Boolean;
+
+implementation
+
+uses
+  ScClientDM, ScUtils, ShellAPI, IniFiles;
+
+{$R *.dfm}
+
+type
+  TEditAccess = class(TcxCustomTextEdit);
+
+// chenshilong, 2011-05-13 10:21:54
+function ShowModifyPwdForm(var AUserName, APW, ANewPW1, ANewPW2: string): Boolean;
+var
+  Form: TModifyPwdFrm;
+begin
+  Result := False;
+  Form := TModifyPwdFrm.Create(nil);
+  try
+    AUserName := UserConfigInfo.UserName;
+    APW := '';
+    Form.cxeUserName.Text := UserConfigInfo.UserName;
+    // ANewPW1 := UserConfigInfo.NewPassWord1;
+    // ANewPW2 := UserConfigInfo.NewPassWord2;
+    // Form.edtPassword.Text := UserConfigInfo.PassWord;
+    
+    if Form.ShowModal = mrOK then
+    begin
+      if APW <> '' then
+        SetEncryptEdit(Form.edtPassword);
+      if ANewPW1 <> '' then
+        SetEncryptEdit(Form.edtNewPassword);
+      if ANewPW2 <> '' then
+        SetEncryptEdit(Form.edtConfirmNewPassword);
+
+      AUserName := Trim(Form.cxeUserName.Text);
+      APW := GetEncryptEditText(Form.edtPassword);
+      ANewPW1 := GetEncryptEditText(Form.edtNewPassword);
+      ANewPW2 := GetEncryptEditText(Form.edtConfirmNewPassword);
+      DisableHookEdit;
+      Result := True;
+    end;
+  finally
+    Form.Free;
+  end;
+end;
+
+{ TLoginFrm }
+
+
+procedure TModifyPwdFrm.edtPasswordEnter(Sender: TObject);
+begin
+  //edtPassword.Clear;
+  SetEncryptEdit(TEdit(Sender));
+end;
+
+procedure TModifyPwdFrm.FormDestroy(Sender: TObject);
+begin
+  RemoveEncryptEdit(edtPassword);
+  RemoveEncryptEdit(edtNewPassword);
+  RemoveEncryptEdit(edtConfirmNewPassword);
+end;
+
+procedure TModifyPwdFrm.edtNewPasswordEnter(Sender: TObject);
+begin
+  //edtNewPassword.Clear;
+  SetEncryptEdit(TEdit(Sender));
+end;
+
+procedure TModifyPwdFrm.edtConfirmNewPasswordEnter(Sender: TObject);
+begin
+  //edtConfirmNewPassword.Clear;
+  SetEncryptEdit(TEdit(Sender));
+end;
+
+procedure TModifyPwdFrm.cxbComfirmClick(Sender: TObject);
+begin
+  if CheckData then
+    ModalResult := mrOK;
+end;
+
+function TModifyPwdFrm.CheckData: Boolean;
+var
+  APW, PWD1, PWD2, ReturnCopy: string;
+  endWord: Char;
+  i: Integer;
+begin
+  APW := GetEncryptEditText(edtPassword);
+  PWD1 := GetEncryptEditText(edtNewPassword);
+  PWD2 := GetEncryptEditText(edtConfirmNewPassword);
+  Result := True;
+  if Trim(cxeUserName.Text) = '' then
+  begin
+    MessageHint(0, '请输入用户名。');
+    Result := False;
+    cxeUserName.SetFocus;
+    Exit;
+  end;
+  if Trim(APW) = '' then
+  begin
+    MessageHint(0, '请输入密码。');
+    Result := False;
+    edtPassword.SetFocus;
+    Exit;
+  end;
+  APW := Trim(APW);
+  if Pos(' ', APW) > 0 then
+  begin
+    MessageHint(0, '请不要在密码中输入空格。');
+    Result := False;
+    edtPassword.SetFocus;
+    Exit;
+  end;
+
+  for I := 1 to Length(APW) do
+  begin
+    ReturnCopy := Copy(APW, I, 1);
+    endWord := ReturnCopy[1];
+    if Ord(endWord) >= 128 then
+    begin
+      MessageHint(0, '请不要在密码中输入汉字。');
+      Result := False;
+      edtPassword.SetFocus;
+      Exit;
+    end;
+  end;
+
+  if Trim(PWD1) = '' then
+  begin
+    MessageHint(0, '请输入新密码。');
+    Result := False;
+    edtNewPassword.SetFocus;
+    Exit;
+  end;
+  PWD1 := Trim(PWD1);
+  if Pos(' ', PWD1) > 0 then
+  begin
+    MessageHint(0, '请不要在新密码中输入空格。');
+    Result := False;
+    edtNewPassword.SetFocus;
+    Exit;
+  end;
+  if (Length(PWD1) < 6) or (Length(PWD1) > 12) then
+  begin
+    MessageHint(0, '您输入的新密码长度不合规范,请重新输入!。');
+    Result := False;
+    edtNewPassword.SetFocus;
+    Exit;
+  end;
+  for I := 1 to Length(PWD1) do
+  begin
+    ReturnCopy := Copy(PWD1, I, 1);
+    endWord := ReturnCopy[1];
+    if Ord(endWord) >= 128 then
+    begin
+      MessageHint(0, '请不要在新密码中输入汉字。');
+      Result := False;
+      edtNewPassword.SetFocus;
+      Exit;
+    end;
+  end;
+
+
+  if Trim(edtConfirmNewPassword.Text) = '' then
+  begin
+    MessageHint(0, '请输入确认密码。');
+    Result := False;
+    edtConfirmNewPassword.SetFocus;
+    Exit;
+  end;
+  PWD1 := GetEncryptEditText(edtNewPassword);
+  PWD2 := GetEncryptEditText(edtConfirmNewPassword);
+  if CompareStr(PWD1, PWD2) <> 0 then
+  begin
+
+    MessageHint(0, '两次输入密码不一致,请重新输入,注意区分大小写。');
+    Result := False;
+    edtNewPassword.SetFocus;
+    Exit;
+  end;
+end;
+
+procedure TModifyPwdFrm.cxbExitClick(Sender: TObject);
+begin
+  close;
+end;
+
+end.

+ 36 - 0
AF/ScProgressFrm.dfm

@@ -0,0 +1,36 @@
+object ProgressFrm: TProgressFrm
+  Left = 395
+  Top = 435
+  BorderIcons = []
+  BorderStyle = bsSingle
+  Caption = #25552#31034
+  ClientHeight = 31
+  ClientWidth = 322
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -12
+  Font.Name = #23435#20307
+  Font.Style = []
+  FormStyle = fsStayOnTop
+  OldCreateOrder = False
+  Position = poMainFormCenter
+  PixelsPerInch = 96
+  TextHeight = 12
+  object lblMessage: TLabel
+    Left = 8
+    Top = 8
+    Width = 300
+    Height = 12
+    Caption = #20998' %d '#20010#25991#20214#23548#20986#65292#27491#22312#23548#20986#31532' %d '#20010#25991#20214#65292#35831#31245#20505#8230#8230
+  end
+  object ProgressBar: TProgressBar
+    Left = 0
+    Top = 23
+    Width = 322
+    Height = 8
+    Align = alBottom
+    Smooth = True
+    TabOrder = 0
+  end
+end

+ 44 - 0
AF/ScProgressFrm.pas

@@ -0,0 +1,44 @@
+unit ScProgressFrm;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, ComCtrls, StdCtrls;
+
+type
+  TProgressFrm = class(TForm)
+    ProgressBar: TProgressBar;
+    lblMessage: TLabel;
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+  end;
+
+procedure ShowFloatProgress(Text: string; Position: Integer);
+procedure CloseFloatProgress;
+
+implementation
+
+{$R *.dfm}
+var
+  ProgressFrm: TProgressFrm = nil;
+
+procedure ShowFloatProgress(Text: string; Position: Integer);
+begin
+  if ProgressFrm = nil then
+    ProgressFrm := TProgressFrm.Create(nil);
+  ProgressFrm.lblMessage.Caption := Text;
+  ProgressFrm.ProgressBar.Position := Position;
+  ProgressFrm.Show;
+  ProgressFrm.Update;
+end;
+
+procedure CloseFloatProgress;
+begin
+  if ProgressFrm <> nil then
+    FreeAndNil(ProgressFrm);
+end;
+
+end.

+ 228 - 0
AF/ScUserInfoFrm.dfm

@@ -0,0 +1,228 @@
+object UserInfoForm: TUserInfoForm
+  Left = 488
+  Top = 220
+  BorderIcons = [biSystemMenu]
+  BorderStyle = bsDialog
+  Caption = #36755#20837#27880#20876#20449#24687
+  ClientHeight = 431
+  ClientWidth = 459
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -12
+  Font.Name = #26032#23435#20307
+  Font.Style = []
+  OldCreateOrder = False
+  Position = poScreenCenter
+  OnCreate = FormCreate
+  OnDestroy = FormDestroy
+  DesignSize = (
+    459
+    431)
+  PixelsPerInch = 96
+  TextHeight = 12
+  object Label1: TLabel
+    Left = 10
+    Top = 4
+    Width = 24
+    Height = 12
+    Caption = #25552#31034
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clBlue
+    Font.Height = -12
+    Font.Name = #26032#23435#20307
+    Font.Style = []
+    ParentFont = False
+  end
+  object Label2: TLabel
+    Left = 10
+    Top = 147
+    Width = 48
+    Height = 12
+    Caption = #35814#32454#36164#26009
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clBlue
+    Font.Height = -12
+    Font.Name = #26032#23435#20307
+    Font.Style = []
+    ParentFont = False
+  end
+  object Label3: TLabel
+    Left = 10
+    Top = 59
+    Width = 48
+    Height = 12
+    Caption = #27880#20876#20449#24687
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clBlue
+    Font.Height = -12
+    Font.Name = #26032#23435#20307
+    Font.Style = []
+    ParentFont = False
+  end
+  object Label4: TLabel
+    Left = 16
+    Top = 76
+    Width = 36
+    Height = 12
+    Caption = #29992#25143#21517
+  end
+  object Label5: TLabel
+    Left = 16
+    Top = 100
+    Width = 24
+    Height = 12
+    Caption = #23494#30721
+  end
+  object Label6: TLabel
+    Left = 16
+    Top = 124
+    Width = 48
+    Height = 12
+    Caption = #30830#35748#23494#30721
+  end
+  object lblBBS: TLabel
+    Left = 8
+    Top = 456
+    Width = 144
+    Height = 12
+    Cursor = crHandPoint
+    Caption = #28857#20987#36825#37324#36827#20837#32437#27178#36719#20214#35770#22363
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clBlue
+    Font.Height = -12
+    Font.Name = #26032#23435#20307
+    Font.Style = []
+    ParentFont = False
+    OnClick = lblBBSClick
+  end
+  object Label7: TLabel
+    Left = 267
+    Top = 96
+    Width = 180
+    Height = 48
+    Caption = #23494#30721#30001#65306'6-12'#20301#23383#31526#65288#23383#27597#12289#25968#23383#13#10#21644#31526#21495#65289#65292#21306#20998#22823#23567#20889#12290#13#10'  '#27880#65306#19981#21487#20197#22312#23494#30721#20013#36755#20837#27721#23383#13#10#21644#31354#26684#65281
+  end
+  object zgUserInfo: TZJGrid
+    Left = 8
+    Top = 160
+    Width = 443
+    Height = 216
+    OptionsEx = []
+    ColCount = 2
+    ShowGridLine = False
+    DefaultColWidth = 300
+    DefaultFixedColWidth = 100
+    Selection.AlphaBlend = False
+    Selection.TransparentColor = False
+    OnMouseDown = zgUserInfoMouseDown
+    OnKeyPress = zgUserInfoKeyPress
+    Anchors = [akLeft, akTop, akRight, akBottom]
+  end
+  object Panel1: TPanel
+    Left = 5
+    Top = 380
+    Width = 449
+    Height = 2
+    Anchors = [akLeft, akRight, akBottom]
+    BevelOuter = bvLowered
+    TabOrder = 0
+  end
+  object btnOK: TButton
+    Left = 297
+    Top = 394
+    Width = 75
+    Height = 22
+    Anchors = [akRight, akBottom]
+    Caption = #25552#20132
+    TabOrder = 9
+    OnClick = btnOKClick
+  end
+  object btnCancel: TButton
+    Left = 377
+    Top = 393
+    Width = 75
+    Height = 22
+    Anchors = [akRight, akBottom]
+    Caption = #21462#28040
+    ModalResult = 2
+    TabOrder = 10
+  end
+  object Panel2: TPanel
+    Left = 40
+    Top = 8
+    Width = 414
+    Height = 2
+    Anchors = [akLeft, akTop, akRight]
+    BevelOuter = bvLowered
+    TabOrder = 1
+  end
+  object Panel3: TPanel
+    Left = 64
+    Top = 152
+    Width = 390
+    Height = 2
+    Anchors = [akLeft, akTop, akRight]
+    BevelOuter = bvLowered
+    TabOrder = 2
+  end
+  object Memo1: TMemo
+    Left = 8
+    Top = 16
+    Width = 437
+    Height = 41
+    Anchors = [akLeft, akTop, akRight]
+    BorderStyle = bsNone
+    Color = clBtnFace
+    Lines.Strings = (
+      #27426#36814#27880#20876#32437#27178#20813#36153#32593#32476#29256#65281#35831#22914#23454#22635#20889#24744#30340#27880#20876#20449#24687#12290
+      ''
+      #32437#27178#23458#26381#20013#24515#65306'0756-3850888')
+    ReadOnly = True
+    TabOrder = 11
+    WantReturns = False
+  end
+  object Panel4: TPanel
+    Left = 64
+    Top = 64
+    Width = 390
+    Height = 2
+    Anchors = [akLeft, akTop, akRight]
+    BevelOuter = bvLowered
+    TabOrder = 3
+  end
+  object edtUserName: TEdit
+    Left = 104
+    Top = 72
+    Width = 145
+    Height = 20
+    TabOrder = 4
+  end
+  object edtPWD: TEdit
+    Left = 104
+    Top = 96
+    Width = 145
+    Height = 20
+    PasswordChar = '*'
+    TabOrder = 6
+    OnEnter = edtPWDEnter
+  end
+  object edtPWD2: TEdit
+    Left = 104
+    Top = 120
+    Width = 145
+    Height = 20
+    PasswordChar = '*'
+    TabOrder = 7
+    OnEnter = edtPWDEnter
+  end
+  object btnCheckUserName: TButton
+    Left = 265
+    Top = 72
+    Width = 120
+    Height = 20
+    Caption = #26816#26597#29992#25143#21517#26159#21542#21487#29992
+    TabOrder = 5
+    OnClick = btnCheckUserNameClick
+  end
+end

+ 369 - 0
AF/ScUserInfoFrm.pas

@@ -0,0 +1,369 @@
+unit ScUserInfoFrm;
+
+interface
+
+uses
+Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, StdCtrls, ExtCtrls, ZJGrid, HookEdit, ZJEdits, ZJCells;
+
+type
+  TUserInfoForm = class(TForm)
+    zgUserInfo: TZJGrid;
+    Panel1: TPanel;
+    btnOK: TButton;
+    btnCancel: TButton;
+    Panel2: TPanel;
+    Panel3: TPanel;
+    Memo1: TMemo;
+    Label1: TLabel;
+    Label2: TLabel;
+    Panel4: TPanel;
+    Label3: TLabel;
+    edtUserName: TEdit;
+    edtPWD: TEdit;
+    edtPWD2: TEdit;
+    Label4: TLabel;
+    Label5: TLabel;
+    Label6: TLabel;
+    btnCheckUserName: TButton;
+    lblBBS: TLabel;
+    Label7: TLabel;
+    procedure btnOKClick(Sender: TObject);
+    procedure btnCheckUserNameClick(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure edtPWDEnter(Sender: TObject);
+    procedure lblBBSClick(Sender: TObject);
+    procedure zgUserInfoMouseDown(Sender: TObject; Button: TMouseButton;
+      Shift: TShiftState; X, Y: Integer);
+    procedure zgUserInfoKeyPress(Sender: TObject; var Key: Char);
+  private
+    { Private declarations }
+    FNew: Boolean;
+    FDataList: TStringList;
+  public
+    { Public declarations }
+    procedure Init(var AName, APwd: string; ADataList: TStringList; ANew: Boolean);
+    procedure SaveList;
+    // 检查输入数据是否合法
+    function CheckData: Boolean;
+  end;
+
+function ShowUserInfoForm(var AName, APwd: string; ADataList: TStringList; ANew: Boolean): Boolean;
+
+implementation
+
+uses
+  ScClientDM, ScUtils, ShellAPI, ScProvinceFrm, IniFiles;
+
+{$R *.dfm}
+
+function ShowUserInfoForm(var AName, APwd: string; ADataList: TStringList; ANew: Boolean): Boolean;
+var
+  Form: TUserInfoForm;
+  bFirstLogon: Boolean;
+begin
+  Result := False;
+  Form := TUserInfoForm.Create(nil);
+  try
+    Form.Init(AName, APWD, ADataList, ANew);
+    if Form.ShowModal = mrOK then
+    begin
+      AName := Trim(Form.edtUserName.Text);
+      APwd := GetEncryptEditText(Form.edtPWD);
+      Form.SaveList;
+      Result := True;
+
+      UserConfigInfo.FirstLogon := False;  // 这句十分重要
+      UserConfigInfo.UserName := AName;
+      UserConfigInfo.PassWord := APwd;
+      UserConfigInfo.SaveToFile;  // 先全部属性保存
+      UserConfigInfo.RememberUserInfo(UserConfigInfo.RememberUser);
+    end;
+  finally
+    Form.Free;
+  end;
+end;
+{var
+  Form: TUserInfoForm;
+begin
+  Result := False;
+  Form := TUserInfoForm.Create(nil);
+  try
+    Form.Init(AName, APWD, ADataList, ANew);
+    if Form.ShowModal = mrOK then
+    begin
+      AName := Trim(Form.edtUserName.Text);
+      APwd := GetEncryptEditText(Form.edtPWD);
+      Form.SaveList;
+      Result := True;
+    end;
+  finally
+    Form.Free;
+  end;
+end; }
+{ TUserInfoForm }
+
+function TUserInfoForm.CheckData: Boolean;
+var
+  I: Integer;
+  slstSub: TStringList;
+  PWD1, PWD2, ReturnCopy: string;
+  endWord: Char;
+begin
+  if Trim(edtUserName.Text) = '' then
+  begin
+    MessageHint(0, '请输入用户名。');
+    Result := False;
+    edtUserName.SetFocus;
+    Exit;
+  end;
+  if FNew and ClientData.UserExists(Trim(edtUserName.Text)) then
+  begin
+    MessageHint(0, '用户名已存在,请重新输入。');
+    Result := False;
+    edtUserName.SetFocus;
+    Exit;
+  end;
+  PWD1 := GetEncryptEditText(edtPWD);
+  if Trim(PWD1) = '' then
+  begin
+    MessageHint(0, '请输入密码。');
+    Result := False;
+    edtPWD.SetFocus;
+    Exit;
+  end;
+  PWD1 := Trim(PWD1);
+  if Pos(' ', PWD1) > 0 then
+  begin
+    MessageHint(0, '请不要在密码中输入空格。');
+    Result := False;
+    edtPWD.SetFocus;
+    Exit;
+  end;
+  if (Length(PWD1) < 6) or (Length(PWD1) > 12) then
+  begin
+    MessageHint(0, '您输入的密码长度不合规范,请重新输入!。');
+    Result := False;
+    edtPWD.SetFocus;
+    Exit;
+  end;
+  for I := 1 to Length(PWD1) do
+  begin
+    ReturnCopy := Copy(PWD1, I, 1);
+    endWord := ReturnCopy[1];
+    if Ord(endWord) >= 128 then
+    begin
+      MessageHint(0, '请不要在密码中输入汉字。');
+      Result := False;
+      edtPWD.SetFocus;
+      Exit;
+    end;
+  end;
+
+  PWD1 := GetEncryptEditText(edtPWD);
+  PWD2 := GetEncryptEditText(edtPWD2);
+  if Trim(PWD2) = '' then
+  begin
+    MessageHint(0, '请输入确认密码。');
+    Result := False;
+    edtPWD2.SetFocus;
+    Exit;
+  end;
+  PWD2 := Trim(PWD2);
+  if Pos(' ', PWD2) > 0then
+  begin
+    MessageHint(0, '请不要在确认密码中输入空格。');
+    Result := False;
+    edtPWD2.SetFocus;
+    Exit;
+  end;
+  if (Length(PWD2) < 6) or (Length(PWD2) > 12) then
+  begin
+    MessageHint(0, '您输入的密码长度不合规范,请重新输入!。');
+    Result := False;
+    edtPWD2.SetFocus;
+    Exit;
+  end;
+  for I := 1 to Length(PWD2) do
+  begin
+    ReturnCopy := Copy(PWD2, I, 1);
+    endWord := ReturnCopy[1];
+    if Ord(endWord) >= 128 then
+    begin
+      MessageHint(0, '请不要在确认密码中输入汉字。');
+      Result := False;
+      edtPWD2.SetFocus;
+      Exit;
+    end;
+  end;
+
+  if FNew and (CompareStr(GetEncryptEditText(edtPWD), GetEncryptEditText(edtPWD2)) <> 0) then
+  begin
+    MessageHint(0, '两次输入密码不一致,请重新输入,注意区分大小写。');
+    Result := False;
+    edtPWD.SetFocus;
+    Exit;
+  end;
+
+  slstSub := TStringList.Create;
+  try
+    slstSub.Delimiter := '|';
+    for I := 0 to FDataList.Count - 1 do
+    begin
+      slstSub.DelimitedText := FDataList[I];
+      if StrToInt(slstSub[3]) = 1 then
+        if zgUserInfo.Cells[1, I + zgUserInfo.FixedRowCount].Text = '' then
+        begin
+          MessageHint(0, Format('请填写[%s]。', [slstSub[0]]));
+          Result := False;
+          zgUserInfo.Selection.SelectRow(I + zgUserInfo.FixedRowCount, I + zgUserInfo.FixedRowCount);
+          Exit;
+        end;
+    end;
+  finally
+    slstSub.Free;
+  end;
+  Result := True;
+end;
+
+procedure TUserInfoForm.Init(var AName, APwd: string; ADataList: TStringList;
+  ANew: Boolean);
+var
+  I: Integer;
+  slstSub: TStringList;
+begin
+  FNew := ANew;
+
+  edtUserName.Enabled := FNew;
+  btnCheckUserName.Enabled := FNew;
+  edtPWD.Enabled := FNew;
+  edtPWD2.Enabled := FNew;
+
+  edtUserName.Text := AName;
+  edtPWD.Text := APwd;
+  edtPWD2.Text := APwd;
+
+  zgUserInfo.RowCount := ADataList.Count + 1;
+  zgUserInfo.Cells[0, 0].Text := '项目';
+  zgUserInfo.Cells[1, 0].Text := '内容';
+
+  zgUserInfo.TextAligns.Cols[1] := gaCenterLeft;
+  zgUserInfo.Cells[1, 0].TextAlign := gaCenterCenter;
+
+  FDataList := ADataList;
+
+  slstSub := TStringList.Create;
+  try
+    slstSub.Delimiter := '|';
+    for I := 0 to FDataList.Count - 1 do
+    begin
+      slstSub.Clear;
+      slstSub.DelimitedText := FDataList[I];
+      zgUserInfo.Cells[0, I + zgUserInfo.FixedRowCount].Text := slstSub[0];
+      zgUserInfo.Cells[1, I + zgUserInfo.FixedRowCount].Text := slstSub[1];
+    end;
+  finally
+    slstSub.Free;
+  end;
+end;
+
+procedure TUserInfoForm.btnOKClick(Sender: TObject);
+begin
+  if CheckData then
+  begin
+    ModalResult := mrOK;
+  end;
+end;
+
+procedure TUserInfoForm.btnCheckUserNameClick(Sender: TObject);
+begin
+  if ClientData.UserExists(Trim(edtUserName.Text)) then
+  begin
+    MessageHint(0, '用户名已存在,请重新输入。');
+    edtUserName.SetFocus;
+  end
+  else
+    MessageHint(0, '用户名可以使用。');
+end;
+
+procedure TUserInfoForm.FormDestroy(Sender: TObject);
+begin
+  RemoveEncryptEdit(edtPWD);
+  RemoveEncryptEdit(edtPWD2);
+end;
+
+procedure TUserInfoForm.SaveList;
+var
+  I: Integer;
+  slstSub: TStringList;
+begin
+  slstSub := TStringList.Create;
+  try
+    slstSub.Delimiter := '|';
+    for I := 0 to FDataList.Count - 1 do
+    begin
+      slstSub.Clear;
+      slstSub.DelimitedText := FDataList[I];
+      slstSub[1] := zgUserInfo.Cells[1, I + zgUserInfo.FixedRowCount].Text;
+      FDataList[I] := slstSub.DelimitedText;
+    end;
+  finally
+    slstSub.Free;
+  end;
+end;
+
+procedure TUserInfoForm.FormCreate(Sender: TObject);
+begin
+  {    欢迎使用SmartCost 2007网络版!
+
+    首先请填写您的注册信息。
+    再联系纵横,即可获取授权码:加此QQ 549244533 (请注明网络版授权)或致电 0756-2285686。
+}
+  Memo1.Lines.Clear;
+  Memo1.Lines.Add('欢迎注册纵横免费网络版!请如实填写您的注册信息。');
+  Memo1.Lines.Add('');
+  Memo1.Lines.Add(Format('纵横客服中心: %s ', [LoadServicePhone]));
+  SetEncryptEdit(edtPWD);
+  SetEncryptEdit(edtPWD2);
+end;
+
+procedure TUserInfoForm.edtPWDEnter(Sender: TObject);
+begin
+  SetEncryptEdit(TEdit(Sender));
+end;
+
+procedure TUserInfoForm.lblBBSClick(Sender: TObject);
+begin
+  ShellExecute(0, nil, 'http://www.smartcost.com.cn/bbs', nil, nil, SW_SHOWNORMAL);
+end;
+
+procedure TUserInfoForm.zgUserInfoKeyPress(Sender: TObject; var Key: Char);
+var sPName: string;
+begin
+  if (zgUserInfo.CurRow = 4) and (zgUserInfo.CurCol = 1) then
+  begin
+    Key := #0;
+    sPName := '';
+    if ExecScProvinceForm(sPName) then
+      zgUserInfo.Cells[1, 4].Text := sPName;
+  end;
+end;
+
+procedure TUserInfoForm.zgUserInfoMouseDown(Sender: TObject;
+  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+  var sPName: string;
+begin
+  // 省份
+  if (Button = mbLeft) then
+  begin
+    if (zgUserInfo.CurRow = 4) and (zgUserInfo.CurCol = 1) then
+    begin
+      sPName := '';
+      if ExecScProvinceForm(sPName) then
+        zgUserInfo.Cells[1, 4].Text := sPName;
+    end;
+  end;
+end;
+
+end.

+ 934 - 0
AF/StdLibsManagerFrm.dfm

@@ -0,0 +1,934 @@
+object StdLibsManagerForm: TStdLibsManagerForm
+  Left = 349
+  Top = 258
+  Width = 469
+  Height = 378
+  BorderIcons = [biSystemMenu]
+  Caption = #26631#20934#28165#21333#31649#29702
+  Color = clBtnFace
+  Font.Charset = ANSI_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -12
+  Font.Name = #23435#20307
+  Font.Style = []
+  OldCreateOrder = False
+  Position = poMainFormCenter
+  OnCreate = FormCreate
+  PixelsPerInch = 96
+  TextHeight = 12
+  object zgLibs: TZJGrid
+    Left = 0
+    Top = 22
+    Width = 461
+    Height = 322
+    OptionsEx = []
+    ColCount = 3
+    ShowGridLine = False
+    DefaultColWidth = 73
+    DefaultFixedColWidth = 25
+    Selection.AlphaBlend = False
+    Selection.TransparentColor = False
+    OnCellTextChanging = zgLibsCellTextChanging
+    Align = alClient
+    PopupMenu = PopupMenu
+  end
+  object ToolBar1: TToolBar
+    Left = 0
+    Top = 0
+    Width = 461
+    Height = 22
+    ButtonWidth = 31
+    Caption = 'ToolBar1'
+    Color = clBtnFace
+    EdgeBorders = []
+    EdgeInner = esNone
+    EdgeOuter = esNone
+    Flat = True
+    Images = ilstProject
+    ParentColor = False
+    TabOrder = 1
+    Transparent = False
+    object ToolButton1: TToolButton
+      Left = 0
+      Top = 0
+      Action = actnDelete
+      ParentShowHint = False
+      ShowHint = True
+    end
+    object ToolButton2: TToolButton
+      Left = 31
+      Top = 0
+      Action = actnRename
+      ParentShowHint = False
+      ShowHint = True
+    end
+    object ToolButton3: TToolButton
+      Left = 62
+      Top = 0
+      Action = actnImport
+      ParentShowHint = False
+      ShowHint = True
+    end
+    object ToolButton4: TToolButton
+      Left = 93
+      Top = 0
+      Action = actnExport
+      ParentShowHint = False
+      ShowHint = True
+    end
+  end
+  object ilstProject: TImageList
+    Left = 232
+    Top = 64
+    Bitmap = {
+      494C010113001800040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
+      0000000000003600000028000000400000006000000001002000000000000060
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000
+      00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000007B63
+      9C008C73AD008C73AD008C73AD008C73AD008C73AD008C73AD008C73AD008C73
+      AD008C73AD008C73AD007B6BA500000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      000000000000000000000000000000000000FFFFFF0000000000FFFFFF000000
+      0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00000000000000000000000000FFFFFF0000000000FFFFFF00FFFF
+      FF00000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF000000000000000000000000000000000000000000000000007B63
+      A500DECEFF00DEC6FF00DEC6FF00D6BDF7005A52BD00CEB5F700D6BDFF00DEC6
+      FF00DEC6FF00E7CEFF007B63A500000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      000000000000000000000000000000000000FFFFFF00F7FFFF0094BDCE0094A5
+      AD00BDBDBD00DED6D600F7EFEF00FFFFFF000000000000000000000000000000
+      0000FFFFFF00FFFFFF000000000000000000FFFFFF00F7FFFF008CB5C6008494
+      9C00B5B5AD00D6CECE00F7EFE700FFFFFF000000000000000000000000000000
+      0000FFFFFF00FFFFFF0000000000000000000000000000000000000000007B63
+      A500BDADD600D6BDF700CEB5EF005A52BD00635ABD00948CBD00B5A5D600DEC6
+      FF00DEC6FF00E7CEFF007B63A500000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      00000000000000000000000000000000000000000000D6EFF70042B5E7004AB5
+      E70042A5CE004A9CB5005A94AD007B9CA500A5ADB500C6C6C600E7DEDE00FFF7
+      F70000000000FFFFFF00FFFFFF000000000000000000DEEFF70052BDE70042B5
+      E700399CC600428CAD00528C9C007B949C00A5A5A500CEC6C600EFE7DE00FFFF
+      F70000000000000000000000000000000000000000005A52BD008C73FF00846B
+      F7005A52BD009484AD005A52BD00846BF7009473FF007363DE005A52BD00DEC6
+      FF00DEC6FF00E7CEFF007B63A500000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      00000000000000000000000000000000000000000000D6EFF7005AC6E7007BDE
+      FF0073DEFF0073DEFF006BDEFF005ACEF70052BDDE004AADC6004A9CAD005A8C
+      A500ADB5B500FFFFFF00FFFFFF00FFFFFF0000000000CEE7F70063C6EF007BDE
+      FF0073DEFF006BDEFF0063D6FF0052C6EF004AB5CE00429CB500528C9C006B8C
+      9400ADADB500FFFFFF0000000000FFFFFF00000000005A52E700634AFF00634A
+      F7005A4AF7005A52BD005252BD00634AFF006352FF006352E7005A52BD00DEC6
+      FF00DEC6FF00E7CEFF007B63A500000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      00000000000000000000000000000000000000000000CEEFF70052BDE70084D6
+      FF0073DEFF007BDEFF0084E7FF0084EFFF008CF7FF008CF7FF0084F7FF006BE7
+      FF004A8C9C00E7DEDE00FFFFFF00FFFFFF0000000000C6E7F70063C6E7007BDE
+      FF0073D6FF007BDEFF0084E7FF0084EFFF008CF7FF008CF7FF0084F7FF0063DE
+      F7004A8C9C00EFE7DE0000000000FFFFFF0000000000000000005A52BD001818
+      EF001010EF001010EF001010EF001818F7002929E700C6B5EF00DECEFF00DEC6
+      FF00DECEFF00E7CEFF007B63A500000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      00000000000000000000000000000000000000000000CEEFF7005AC6F70084D6
+      F7007BE7FF007BE7FF0084EFFF0084EFFF008CEFFF008CF7FF0094F7FF00A5FF
+      FF0063B5C600A5ADAD0000000000FFFFFF0000000000C6E7F70073CEE70084E7
+      FF0073DEFF007BE7FF0084E7FF0084EFFF008CEFFF008CF7FF0094F7FF0094FF
+      FF0052A5B500D6CECE0000000000FFFFFF000000000000000000000000002929
+      DE001010E7000810EF001010EF002929E7005A52BD00DECEFF00DECEFF00DECE
+      FF00DEC6FF00E7CEFF007B63A500000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      00000000000000000000000000000000000000000000C6E7F7006BCEF7007BD6
+      F7008CEFFF007BE7FF0084EFFF008CF7FF0094F7FF00A5F7FF00ADF7FF00B5F7
+      FF0094CEDE00738C9C00FFF7F700FFFFFF0000000000BDE7F7006BCEEF008CE7
+      FF007BE7FF0084EFFF0084EFFF008CF7FF008CF7FF008CF7FF008CF7FF008CF7
+      FF0052A5B500C6C6C60000000000FFFFFF000000000000000000000000003131
+      E7002121E7002929EF002929EF003131E7005A52BD00E7D6FF00E7D6FF00DECE
+      FF00DECEFF00E7CEFF007B63A500000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      00000000000000000000000000000000000000000000BDE7EF0073D6FF006BCE
+      F700ADF7FF0094F7FF00A5FFFF00ADFFFF00B5F7FF00BDF7FF00C6F7FF00C6F7
+      FF00CEE7E7006B9CAD00CECECE00FFFFFF0000000000B5E7F70073CEEF008CE7
+      FF0084EFFF008CEFFF008CF7FF008CF7FF008CF7FF008CF7FF008CF7FF0084EF
+      FF005AA5BD00ADB5B50000000000FFFFFF0000000000000000005A52BD005252
+      EF005A5AEF005A5AEF005A5AEF005A5AEF006363EF00CEBDF700E7D6FF00DECE
+      FF00DECEFF00E7D6FF007B63A500000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      00000000000000000000000000000000000000000000B5DEEF0084DEFF0063D6
+      F70084D6EF00A5E7F700B5EFF700C6F7FF00DEFFFF00DEFFFF00E7FFFF00E7FF
+      FF00F7F7F7009CC6D6008C9CA5000000000000000000B5E7F70073CEEF009CEF
+      FF008CF7FF008CF7FF008CF7FF008CF7FF008CF7FF0094F7FF009CF7FF00A5EF
+      FF0073B5C60094A5AD0000000000FFFFFF00000000008C8CE700948CEF008C8C
+      EF008484E700E7DEFF005A52BD009494F7009494F7008C8CEF005A52BD00E7D6
+      FF00E7D6FF00E7D6FF007B63A500000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      00000000000000000000000000000000000000000000ADDEEF0084E7FF007BE7
+      FF006BDEFF006BD6F7006BD6F70063D6EF009CDEEF00D6EFF700E7F7FF00F7FF
+      FF00FFFFFF00E7F7F700638C9C00EFEFE70000000000B5E7F70073D6F70084DE
+      EF009CEFF7009CEFFF00ADF7FF00A5FFFF00A5F7FF00B5F7FF00BDF7FF00CEF7
+      FF00A5CEDE007B9CA500FFFFFF00FFFFFF00000000005A52BD00A5A5F7009494
+      E7005A52BD00F7F7FF00EFEFFF009494E700ADADF7005A52BD00C6BDEF00EFDE
+      FF00EFDEFF00EFDEFF007B63A500000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      000000000000000000000000000000000000FFFFFF00ADDEEF008CE7FF007BE7
+      FF0084EFFF0084EFFF0084EFFF0084F7FF0073E7FF006BDEF70073DEEF0073D6
+      EF0084BDD600ADDEEF0084BDCE00EFEFEF00FFFFFF00ADDEEF008CE7FF006BDE
+      F70073D6F70073D6EF0073D6EF00BDEFF700D6FFFF00DEFFFF00EFFFFF00FFFF
+      FF00E7F7FF006B94A500F7F7EF00000000000000000000000000000000007B63
+      A500FFF7FF00F7F7FF00F7F7FF00EFEFFF005A52BD00F7EFFF00EFDEFF007B63
+      A5007B63A5007B63A5007B63A500000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      000000000000000000000000000000000000FFFFFF00A5DEEF009CEFFF0084EF
+      FF0084EFFF008CF7FF009CEFFF0094EFFF0094F7FF0094F7FF009CFFFF0073E7
+      F7006B8C9C00EFF7F700FFFFFF0000000000FFFFFF00A5DEEF009CEFFF0084F7
+      FF0084F7FF0094F7FF0094EFFF0073D6EF0084D6EF0094DEEF00A5E7F700ADE7
+      F700ADD6EF0094BDCE00FFF7F700FFFFFF000000000000000000000000007B63
+      A500FFFFFF00FFF7FF00F7F7FF00F7F7FF00F7F7FF00F7F7FF00F7EFFF00BDA5
+      F700D6BDFF007B63A50000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      000000000000000000000000000000000000FFFFFF00D6EFF7008CDEEF009CEF
+      FF0094EFFF009CE7F70084B5C600BDDEEF00ADDEEF00A5DEEF009CDEEF0084D6
+      E700B5C6CE00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D6EFF7008CDEEF009CEF
+      F70094EFFF0094E7F7008CB5C600BDDEEF00ADDEEF009CD6EF008CD6EF0073CE
+      E70094BDCE00F7FFFF00FFFFFF00FFFFFF000000000000000000000000007B63
+      A500FFFFFF00FFF7FF00FFF7FF00FFF7FF00F7F7FF00F7F7FF00F7EFFF00DECE
+      F7007B63A5000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      000000000000000000000000000000000000FFFFFF0000000000CEEFF700BDDE
+      EF00B5DEEF00A5D6E700EFEFEF000000000000000000FFFFFF00FFFFFF00F7F7
+      FF0000000000FFFFFF00FFFFFF0000000000FFFFFF0000000000CEEFF700BDDE
+      EF00B5DEEF00A5D6E700EFEFEF0000000000FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF000000000000000000FFFFFF00000000000000000000000000000000007B63
+      A500FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF007B63
+      A500000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      00000000000000000000000000000000000000000000FFFFFF00000000000000
+      0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00000000000000
+      0000FFFFFF0000000000000000000000000000000000FFFFFF00000000000000
+      0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00000000000000
+      0000FFFFFF00FFFFFF0000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000394242001021290029292900212931002921390021212900182131001821
+      29001829290021313900182931000000000000000000529C5200087B08000884
+      0800108C1000108C1000188C1800218C2100298C2900298C2900298C29002984
+      290029842900217B21006BAD6B000000000000000000529C5200108410002194
+      210029942900319C3100399C390042A542004AA54A0052AD52005AAD5A0063B5
+      630073BD73007BBD7B00A5CEA500000000000000000000000000000000000000
+      000000000000C6635A00C6635A00C6635A00C6635A00C6635A00C6635A00C663
+      5A00C6635A00C6635A00C6635A00000000000000000000000000000000000000
+      0000C6CEC600E7F7FF00D6DEEF00CEE7F700CEE7EF00C6DEEF00B5C6D6009CC6
+      DE00A5CEEF00A5CEEF009CBDE7002121390000000000007B0000009C000000A5
+      000008A5080010A5100021A521004AB54A004AAD4A00299C2900299429002994
+      2900319C3100319C31002994290000000000000000001073100021942100319C
+      3100399C390042A5420052AD52007BBD7B0084C6840063B563006BB56B0073BD
+      73008CC68C009CCE9C007BBD7B00000000000000000000000000000000000000
+      000000000000C6635A00F7DED600FFE7D600FFE7D600FFE7D600FFE7D600FFE7
+      D600FFE7CE00FFE7D600C6635A00000000000000000000000000000000000000
+      0000CED6CE00E7EFFF00DEE7EF00D6E7E700B5BDC6008C94AD009CADBD00BDD6
+      E700ADD6EF00A5D6F700A5CEEF0021293900000000000084000000A5000008AD
+      080010B5100010AD100052BD5200FFFFFF00FFFFFF0052AD5200299C29002994
+      2900399C390042A54200399C39000000000000000000187B180029942900399C
+      390042A542004AA54A006BB56B00FFFFFF00FFFFFF0073B5730063B563006BB5
+      6B007BBD7B008CC68C0073BD73000000000000000000C6635A00C6635A00C663
+      5A00C6635A00C6635A00F7DED600FFCE9C00FFCE9C00FFCE9400FFCE9400FFC6
+      8C00FFC68C00FFDEC600C6635A00000000000000000000000000000000000000
+      0000D6D6D600DEE7F700BDCED60094A59C0073737300211008008C9CA500CEEF
+      FF00B5DEEF00A5D6E700A5D6E70018213100000000000884080010AD100010B5
+      100021B521004AC64A00FFFFFF00FFFFFF00FFFFFF00FFFFFF0052AD5200319C
+      310042A542004AA54A004AA54A000000000000000000217B2100319C3100399C
+      39004AA54A004AA54A006BB56B00FFFFFF00FFFFFF006BB56B005AAD5A005AAD
+      5A006BB56B0073BD730063B563000000000000000000C6635A00F7B5AD00F7B5
+      AD00EFADA500C6635A00F7E7D600FFDEC600FFDEC600FFDEC600FFDEC600FFDE
+      C600FFDEC600FFE7D600C6635A00000000000000000000000000000000000000
+      0000BDBDBD00CEC6CE0094948C00213110003139630052738400DEEFF700BDDE
+      F700C6DEE700BDDEE700B5D6E7000000000000000000088C080010AD100018B5
+      180052C65200DEF7DE00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D6EFD60052AD
+      520042A5420052AD52004AA54A000000000000000000217B2100319C310039A5
+      390042A542004AA54A006BB56B00FFFFFF00FFFFFF0063B5630052AD52005AAD
+      5A0063B563006BB56B0063B563000000000000000000C6635A00FFEFDE00FFEF
+      DE00F7DECE00C6635A00FFE7D600FFC68C00FFC68C00FFC68C00FFC68C00FFC6
+      8400FFC68400FFDEC600C6635A00000000000000000000000000000000000000
+      0000737B5A0021312100394AAD004A73AD009CBDFF00D6E7DE00CEE7FF00D6E7
+      EF00CEDEE700BDDEE700B5DEE7000000000000000000108C100021AD21005AC6
+      5A00FFFFFF00FFFFFF00DEF7DE00FFFFFF00FFFFFF00DEEFDE00FFFFFF00FFFF
+      FF0073BD73005AAD5A0052AD5200000000000000000018841800319C31004AAD
+      4A005AB55A0042AD420063B56300FFFFFF00FFFFFF005AAD5A004AA54A0063B5
+      63006BB56B006BB56B005AAD5A000000000000000000C6635A00FFD6B500FFD6
+      AD00FFCEA500C6635A00FFE7DE00FFDEC600FFDEC600FFDEC600FFDEC600FFDE
+      C600FFDEC600FFE7D600C6635A00000000000000000000000000000000001821
+      290031425A00396384005A84CE00B5D6FF00B5DEE700DEDEF700E7FFEF00CEDE
+      F700D6E7EF00CEE7E700C6DEE70000000000000000001884180052B55200DEF7
+      DE00FFFFFF00EFF7EF0063BD6300FFFFFF00FFFFFF005AAD5A00F7FFF700FFFF
+      FF00DEEFDE007BBD7B0052AD520000000000000000001884180042AD4200C6E7
+      C600C6E7C6004AAD4A005AB55A00FFFFFF00FFFFFF0052AD520052A55200CEE7
+      CE00CEE7CE0073BD730052AD52000000000000000000C6635A00FFCEA500FFCE
+      A500FFC69C00C6635A00FFEFE700FFCE9C00FFCE9C00FFCE9C00FFCE9C00FFCE
+      9C00FFCE9C00FFE7CE00C6635A0000000000000000000000000010211000215A
+      B500104AB5005284BD0094B5FF00E7FFFF00D6D6D600F7FFFF00DEEFF700E7F7
+      F700DEEFEF00D6E7E700CEE7E70000000000000000001884180042AD4200C6E7
+      C600C6E7C6004AAD4A005AB55A00FFFFFF00FFFFFF0052AD520052A55200CEE7
+      CE00CEE7CE0073BD730052AD520000000000000000001884180052B55200DEF7
+      DE00FFFFFF00EFF7EF0063BD6300FFFFFF00FFFFFF005AAD5A00F7FFF700FFFF
+      FF00DEEFDE007BBD7B0052AD52000000000000000000C6635A00FFDEC600FFDE
+      BD00FFD6B500C6635A00FFF7EF00FFEFD600FFE7D600FFE7CE00FFE7C600FFDE
+      BD00FFDEBD00FFE7D600C6635A000000000000000000182129000042B500087B
+      EF000852FF0084BDEF00D6EFFF007BB5F700F7F7FF00FFFFFF00F7FFFF00E7F7
+      FF00EFF7FF00DEDEE700CEDEEF00000000000000000018841800319C31004AAD
+      4A005AB55A0042AD420063B56300FFFFFF00FFFFFF005AAD5A004AA54A0063B5
+      63006BB56B006BB56B005AAD5A000000000000000000108C100021AD21005AC6
+      5A00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF0073BD73005AAD5A0052AD52000000000000000000C6635A00FFD6A500FFCE
+      9C00FFC69400C6635A00FFFFF700FFFFFF00FFFFFF00FFFFFF00FFF7F700FFF7
+      EF00FFDECE00F79C9400C6635A0000000000213121000052B500006BF700008C
+      FF000094EF00ADCEF70094E7FF00FFFFEF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00EFF7F700E7E7E700D6DEE7000000000000000000217B2100319C310039A5
+      390042A542004AA54A006BB56B00FFFFFF00FFFFFF0063B5630052AD52005AAD
+      5A0063B563006BB56B0063B563000000000000000000088C080010AD100018B5
+      180052C65200FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0052AD
+      520042A5420052AD52004AA54A000000000000000000C6635A00FFE7CE00FFE7
+      C600FFD6B500C6635A00FFFFF700FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFF7
+      F700E7B5A500DE845200C6635A00000000000852BD00006BCE000094FF000073
+      FF0073CEFF005A9CD600FFFFE700FFF7FF00FFFFFF00FFFFFF00F7F7EF00FFF7
+      F700E7EFF700D6DEDE00B5BDC6000008000000000000217B2100319C3100399C
+      39004AA54A004AA54A006BB56B00FFFFFF00FFFFFF006BB56B005AAD5A005AAD
+      5A006BB56B0073BD730063B5630000000000000000000884080010AD100010B5
+      100021B521004AC64A00FFFFFF00FFFFFF00FFFFFF00FFFFFF0052AD5200319C
+      310042A542004AA54A004AA54A000000000000000000C6635A00FFD6A500FFCE
+      9C00FFC69400C6635A00FFEFDE00FFEFE700FFE7DE00F7E7DE00F7E7DE00F7DE
+      D600E7A59C00C6635A00FFE7DE00000000000884FF000084FF000084E70084C6
+      DE00739CDE00FFDEE700FFFFFF00FFFFFF00FFFFFF00EFF7F700FFFFFF00DEE7
+      E700C6CECE00A5ADAD006B737B000008000000000000187B180029942900399C
+      390042A542004AA54A006BB56B00FFFFFF00FFFFFF0073B5730063B563006BB5
+      6B007BBD7B008CC68C0073BD730000000000000000000084000000A5000008AD
+      080010B5100010AD100052BD5200DEF7DE00D6EFD60052AD5200299C29002994
+      2900399C390042A54200399C39000000000000000000C6635A00FFFFFF00FFFF
+      FF00FFF7F700C6635A00C6635A00C6635A00C6635A00C6635A00C6635A00C663
+      5A00C6635A000000000000000000000000000894F700007BFF0094E7FF005294
+      EF00B5BDD600FFFFFF00FFFFFF00F7FFFF00E7E7E700FFFFFF00FFFFFF006363
+      6300D6D6D600FFFFFF006B6B6B0000000000000000001073100021942100319C
+      3100399C390042A5420052AD52007BBD7B0084C6840063B563006BB56B0073BD
+      73008CC68C009CCE9C007BBD7B000000000000000000007B0000009C000000A5
+      000008A5080010A5100021A521004AB54A004AAD4A00299C2900299429002994
+      2900319C3100319C3100299429000000000000000000C6635A00FFFFFF00FFFF
+      FF00FFFFFF00FFFFFF00FFF7EF00EFCEBD00D6736300D66B5A00C6635A000000
+      0000000000000000000000000000000000000084FF00C6FFF7004294FF000000
+      0000CECEC600FFFFFF00FFFFFF00FFFFFF00F7F7F700FFFFFF00FFFFFF004A4A
+      4A00DEDEDE0094949400000000000000000000000000529C5200108410002194
+      210029942900319C3100399C390042A542004AA54A0052AD52005AAD5A0063B5
+      630073BD73007BBD7B00A5CEA5000000000000000000529C5200087B08000884
+      0800108C1000108C1000188C1800218C2100298C2900298C2900298C29002984
+      290029842900217B21006BAD6B000000000000000000C6635A00FFFFFF00FFFF
+      FF00FFFFFF00FFFFFF00FFFFF700EFC6B500E7945A00C6635A00000000000000
+      000000000000000000000000000000000000ADE7E7003984D600000000000000
+      0000CEC6C600FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004A4A
+      4A00949494000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      00000000000000000000000000000000000000000000C6635A00C6635A00C663
+      5A00C6635A00C6635A00C6635A00C6635A00C6635A0000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000B5B5B500BDC6CE00CEC6CE00CECEC600BDBDBD00B5B5B500949494004242
+      4200000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      00000000000000000000000000000000000000000000319CFF00319CFF00319C
+      FF00319CFF00319CFF0000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000031
+      FF008CA5D6008CA5D6008CA5D6008CA5D6008CA5D6008CA5D6008CA5D6008CAD
+      D6000031FF000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      00000000000000000000000000000000000000000000319CFF0031CEFF0031CE
+      FF0031CEFF0029CEFF00319CFF00319CFF00319CFF00319CFF00000000000000
+      000000000000000000000000000000000000000000000000000000FFFF00BDBD
+      BD0000FFFF00BDBDBD0000FFFF00BDBDBD0000FFFF00BDBDBD0000FFFF000000
+      0000000000000000000000000000000000000000000000000000000000000031
+      FF000031FF000031FF000031FF000031FF000031FF000031FF000031FF000031
+      FF000031FF000000000000000000000000000000000000000000000000000000
+      000000000000000000000000000000000000ADADAD009C9C9C00949494009494
+      940073737300737373006B737300A5A5A50000000000319CFF0039B5FF0042D6
+      FF0039CEFF0039CEFF0031CEFF0031CEFF0029CEFF0029C6FF00319CFF00319C
+      FF00000000000000000000000000000000000000000000FFFF000000000000FF
+      FF00BDBDBD0000FFFF00BDBDBD0000FFFF00BDBDBD0000FFFF00BDBDBD0000FF
+      FF0000000000FFFFFF00FFFFFF0000000000000000000000000000000000CE63
+      00009CADCE009CB5CE009CB5CE00A5B5CE00A5B5C6009CB5C6009CADC6009CAD
+      C600CE6300000000000000000000000000007B84BD003152E700000000000000
+      0000BDBDBD008C8C8C00737373006B6B6B006B6B6B006B6B6B006B6B6B006B6B
+      6B006B6B6B006B6B6B00636363009CA59C0000000000319CFF0042B5FF0063D6
+      FF0063DEFF005ADEFF004AD6FF0039CEFF0031CEFF0031CEFF0031CEFF0021CE
+      FF00319CFF0000000000000000000000000000000000FFFFFF0000FFFF000000
+      000000FFFF00BDBDBD0000FFFF00BDBDBD0000FFFF00BDBDBD0000FFFF00BDBD
+      BD0000FFFF0000000000FFFFFF0000000000000000000000000000000000CE63
+      0000CE630000CE630000CE630000CE630000CE630000CE630000CE630000CE63
+      0000CE630000000000000000000000000000000000006B7BC6001031FF008C8C
+      AD0000000000000000000000000000000000000000009C9C9C008C8C8C008484
+      8400848484007B7B7B00636B6B009CA5A50000000000319CFF004ABDFF006BCE
+      FF0084E7FF0073DEFF006BDEFF0063DEFF004AD6FF0031CEFF0031CEFF0021CE
+      FF00319CFF000000000000000000000000000000000000FFFF00FFFFFF0000FF
+      FF00000000000000000000000000000000000000000000000000000000000000
+      00000000000000000000FFFFFF0000000000000000000000000000000000009C
+      000084BDC6008CBDC6008CC6C6008CC6C6008CC6C6008CC6C60084C6C600009C
+      0000CE6300000000000000000000000000000000000000000000ADB5F700B5B5
+      CE009494AD000000000000000000000000000000000000000000000000000000
+      00000000000000000000000000000000000000000000319CFF00319CFF007BCE
+      FF00ADEFFF00A5EFFF009CEFFF00187B3100187B3100187B3100187B310042D6
+      FF0042CEFF00319CFF00000000000000000000000000FFFFFF0000FFFF00FFFF
+      FF0000FFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000000000000000009C
+      0000009C0000009C0000009C0000009C0000009C0000009C0000009C0000009C
+      0000CE630000000000000000000000000000000000000000000000000000CECE
+      DE00C6BDE700948CAD009C9CA500000000000000000000000000000000000000
+      00000000000000000000000000000000000000000000319CFF007BDEFF00319C
+      FF00319CFF00B5EFFF00ADEFEF00187B3100ADFFCE00ADFFCE00187B310073DE
+      EF007BE7FF00319CFF0000000000000000000000000000FFFF00FFFFFF0000FF
+      FF00FFFFFF0000FFFF0000000000FFFFFF000000000000000000000000000000
+      00000000000000000000FFFFFF0000000000000000000000000000000000009C
+      000031E7AD004AEFB5006BF7C6007BFFCE0073FFC60063F7BD0039E7B50021E7
+      AD00CE630000000000000000000000000000000000000000000000000000BDBD
+      BD00DED6F700C6C6E700948CB500847B94000000000000000000000000000000
+      00000000000000000000000000000000000000000000319CFF0094EFFF0094EF
+      FF0073D6FF00319CFF00319CFF00187B3100ADFFCE00ADFFCE00187B3100ADF7
+      FF00B5EFFF00B5EFFF00319CFF000000000000000000FFFFFF0000FFFF00FFFF
+      FF0000FFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000000000000000009C
+      000021E7AD0039E7B50052EFB5005AF7BD005AF7BD004AEFB50031E7AD0018DE
+      A500CE6300000000000000000000000000000000000000000000000000000000
+      0000B5B5C600E7DEF700CEC6EF009C9CDE005A63B5009C9CAD00000000000000
+      00000000000000000000000000000000000000000000319CFF00A5EFFF00A5EF
+      FF009CEFFF009CEFFF00ADF7FF00187B310052B5FF0063BDFF00187B3100319C
+      FF00C6F7FF00CEF7FF00319CFF00000000000000000000000000FFFFFF0000FF
+      FF00FFFFFF0000FFFF0000000000FFFFFF000000000000000000000000000000
+      00000000000000000000FFFFFF0000000000000000000000000000000000009C
+      000010DEA50029E7AD0039E7B50042EFB50039EFB50031E7AD0021DEA50008DE
+      A500CE6300000000000000000000000000000000000000000000000000000000
+      000000000000D6CEE700DEE7FF008C94F7000029EF002139C600000000000000
+      00000000000000000000000000000000000000000000319CFF00A5F7FF00A5F7
+      FF00A5F7FF00A5EFFF00ADF7FF00187B310052DE840052DE7B00187B3100319C
+      FF00319CFF00319CFF00319CFF0000000000000000007B7B7B00000000000000
+      0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000000000000000009C
+      000000D69C0010DEA50018DEAD0021DEAD0018DEAD0010DEA50008D69C0000CE
+      9C00CE6300000000000000000000000000000000000000000000000000000000
+      00000000000000000000638CF7000839FF000029FF000021F7002139C600949C
+      AD000000000000000000000000000000000000000000319CFF00ADF7FF00ADF7
+      FF00ADF7FF00187B3100187B3100187B310063E78C0052DE8400187B3100187B
+      3100187B31000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000FFFFFF000000000000000000FFFFFF00FFFF
+      FF0000000000000000000000000000000000000000000000000000000000009C
+      000000C6940000CE9C0000D69C0000D69C0000D69C0000D69C0000CE940000BD
+      9400000000000000000000000000000000000000000000000000000000000000
+      000000000000000000008C9CBD00105AFF000029FF000029FF000021EF002131
+      C6000000000000000000000000000000000000000000319CFF00319CFF00319C
+      FF00319CFF00319CFF00187B3100ADF7CE00ADFFCE00ADFFCE009CEFBD00187B
+      3100000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF0000000000FFFFFF000000000000000000000000000000000000000000009C
+      000000AD840000B58C0000BD940000C6940000C6940000BD940000B58C0000A5
+      8400000000000000000000000000000000000000000000000000000000000000
+      000000000000000000000000000000000000105AFF000031FF000029FF000029
+      F7002139C600949CAD0000000000000000000000000000000000000000000000
+      0000000000000000000000000000187B3100B5FFCE00B5FFCE00187B31000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF0000000000000000000000000000000000000000000000000000000000009C
+      000000947B0000A5840000AD840000AD840000AD840000AD8400009C7B000094
+      7B00000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000008C9CBD00397BFF002952FF002952
+      FF00294AEF004A63CE0000000000000000000000000000000000000000000000
+      000000000000000000000000000000000000187B3100187B3100000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      000000000000000000000000000000000000000000000000000000000000009C
+      0000009C0000009C0000009C0000009C0000009C0000009C0000009C0000009C
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000CE524200CE52
+      4200CE5A4A00CE524A00CE524200CE524200CE524200CE523900CE523900CE52
+      3900CE523900D6421000D6421000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000CE524200FFCE
+      AD00FFD6B500FFD6B500FFCEA500FFCE9C00FFC68C00FFC68400FFBD8400FFBD
+      7B00FFB57300F79C6B00D642100000000000000000000000000084848400CECE
+      CE00CECECE00CECECE00CECECE00CECECE00CECECE00CECECE00CECECE00CECE
+      CE00CECECE00CECECE00000000000000000000000000319CFF00319CFF00319C
+      FF00319CFF00319CFF0000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000CE524200FFDE
+      C600FFE7BD00FFE7B500FFDEB500FFDEAD00FFD69C00FFCE8C00FFCE8400FFC6
+      7B00FFBD7300F7A56B00D642100000000000000000000000000084848400FFFF
+      FF00FFFFFF009CFFFF00FFFFFF009CFFFF00009C31009CFFFF00FFFFFF009CFF
+      FF00FFFFFF00CECECE00000000000000000000000000319CFF0031CEFF0031CE
+      FF0031CEFF0029CEFF00319CFF00319CFF00319CFF00319CFF00000000000000
+      0000000000000000000000000000000000000000000000000000009C9C00009C
+      9C00009C9C00009C9C00009C9C00009C9C00009C9C00009C9C00009C9C00009C
+      9C00009C9C00009C9C0000000000000000000000000000000000CE524200FFD6
+      BD00FFDEB500FFDEB500FFDEAD00FFDEAD00FFD6A500FFD69C00FFD69400FFCE
+      9400FFC68400F7A57B00D642100000000000000000000000000084848400FFFF
+      FF009CFFFF00FFFFFF009CFFFF00009C3100009C3100FFFFFF009CFFFF00FFFF
+      FF009CFFFF00CECECE00000000000000000000000000319CFF0039B5FF0042D6
+      FF0039CEFF0039CEFF0031CEFF0031CEFF0031CEFF0031CEFF00319CFF00319C
+      FF00000000000000000000000000000000000000000000000000009C9C00FFFF
+      FF009CCEFF009CFFFF009CCEFF009CFFFF009CCEFF009CCEFF009CCEFF009CCE
+      FF0063CECE00009C9C0000000000000000000000000000000000CE524200FFD6
+      B500FFCE9C00FFCE9C00FFCE9C00FFCE9C00FFCE9400FFCE9400FFC69400FFC6
+      8C00FFC68400F7AD7B00D642100000000000000000000000000084848400FFFF
+      FF00FFFFFF009CFFFF00009C3100009C3100009C3100009C3100009C31009CFF
+      FF00FFFFFF00CECECE00000000000000000000000000319CFF0042B5FF0063D6
+      FF0063DEFF005ADEFF004AD6FF0031CEFF00107318001073180031CEFF0021CE
+      FF00319CFF0000000000000000000000000000000000009C9C00FFFFFF009CFF
+      FF009CFFFF009CCEFF009CFFFF009CCEFF009CFFFF009CCEFF009CCEFF009CCE
+      FF0063CECE0000000000009C9C00000000000000000000000000CE524200FFEF
+      DE00FFCE9C00FFCE9C00FFCE9C00EFCEA500FFDEAD00FFDEAD00FFD6A500FFD6
+      9C00FFCE8C00F7AD8400D642100000000000000000000000000084848400FFFF
+      FF009CFFFF00FFFFFF009CFFFF00009C3100009C3100FFFFFF00639C00006363
+      00009CFFFF00CECECE00000000000000000000000000319CFF004ABDFF006BCE
+      FF0084E7FF0073DEFF0031CEFF0010731800B5FFCE00ADF7C6001073180031CE
+      FF00319CFF0000000000000000000000000000000000009C9C00FFFFFF009CFF
+      FF009CFFFF009CFFFF009CFFFF009CFFFF009CCEFF009CFFFF009CCEFF009CCE
+      FF00009C9C0000000000009C9C00000000000000000000000000CE524200FFE7
+      C600FFE7C600FFE7C600FFE7C600D6B59400BDC6CE00BDC6CE00BDC6CE00BDC6
+      CE00BDC6CE00D6ADA500D642100000000000000000000000000084848400FFFF
+      FF00FFFFFF009CFFFF00FFFFFF009CFFFF00009C31009CFFFF00FFFFFF006363
+      0000FFFFFF00CECECE00000000000000000000000000319CFF0063C6FF007BCE
+      FF00ADEFFF0031CEFF0010731800B5FFCE00B5FFCE00ADFFCE00A5EFBD001073
+      180031CEFF00319CFF000000000000000000009C9C00FFFFFF009CFFFF009CFF
+      FF009CFFFF009CFFFF009CCEFF009CFFFF009CFFFF009CCEFF009CFFFF0063CE
+      CE000000000063CECE0063CECE00000000000000000000000000CE524200FFFF
+      FF00081010000008080029292100FFE7C600319CFF00319CFF00319CFF00319C
+      FF00319CFF00949CBD00D642100000000000000000000000000084848400FFFF
+      FF009CFFFF00636300009CFFFF00FFFFFF009CFFFF00FFFFFF009CFFFF006363
+      00009CFFFF00CECECE00000000000000000000000000319CFF00319CFF00319C
+      FF00319CFF0010731800107318001073180084EFAD0073E79C00107318001073
+      180010731800319CFF000000000000000000009C9C00FFFFFF009CFFFF009CFF
+      FF009CFFFF009CFFFF009CFFFF009CFFFF009CCEFF009CFFFF009CCEFF0063CE
+      CE000000000063CECE0063CECE00000000000000000000000000CE5242000008
+      0800000808000008080010101000FFE7C600319CFF00319CFF00319CFF00319C
+      FF00319CFF00FFB59C00D642100000000000000000000000000084848400FFFF
+      FF00FFFFFF0063630000FFFFFF009CFFFF00009C31009CFFFF00FFFFFF009CFF
+      FF00FFFFFF00CECECE00000000000000000000000000319CFF0094EFFF0094EF
+      FF0073D6FF00319CFF00319CFF0010731800BDEFF700C6F7F7001073180031CE
+      FF00B5EFFF00B5EFFF00319CFF0000000000009C9C00009C9C00009C9C00009C
+      9C00009C9C00009C9C00009C9C00009C9C00009C9C00009C9C00009C9C00009C
+      9C0063CECE009CFFFF0063CECE00000000000000000000000000CE5242000008
+      080010FFFF000008080000000000FFE7C600FFE7C600FFE7C600FFE7C600FFCE
+      9C00FFD6A500FFB59C00D642100000000000000000000000000084848400FFFF
+      FF009CFFFF0063630000639C0000FFFFFF00009C3100009C31009CFFFF00FFFF
+      FF009CFFFF00CECECE00000000000000000000000000319CFF00A5EFFF00A5EF
+      FF009CEFFF009CEFFF00A5EFFF0010731800319CFF00319CFF0010731800319C
+      FF00C6F7FF00CEF7FF00319CFF000000000000000000009C9C00FFFFFF009CFF
+      FF009CFFFF009CFFFF009CFFFF009CFFFF009CFFFF009CFFFF009CFFFF009CFF
+      FF009CFFFF009CFFFF0063CECE00000000000000000000080800000808000008
+      080010FFFF0000080800000808000008080008080800FFE7C600F7DEBD00FFE7
+      C600FFC6AD00FF948400D642100000000000000000000000000084848400FFFF
+      FF00FFFFFF009CFFFF00009C3100009C3100009C3100009C3100009C31009CFF
+      FF00FFFFFF00CECECE00000000000000000000000000319CFF00A5F7FF00A5F7
+      FF00A5F7FF00A5EFFF00A5EFFF00107318005ADE84005ADE840010731800319C
+      FF00319CFF00319CFF00319CFF000000000000000000009C9C00FFFFFF009CFF
+      FF009CFFFF009CFFFF009CFFFF009CFFFF009CFFFF009CFFFF00FFFFFF00FFFF
+      FF00FFFFFF00FFFFFF0063CECE0000000000000000000008080010FFFF0010FF
+      FF0000FFFF0010FFFF0010FFFF000008080018181800FFE7C600F7CEA500F7B5
+      9C00F77B7300EF5A5200D642100000000000000000000000000084848400FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00009C3100009C31009CFFFF00FFFF
+      FF00CECECE00CECECE00000000000000000000000000319CFF00ADF7FF00ADF7
+      FF00A5F7FF00A5F7FF00319CFF00107318005ADE84005ADE8400107318000000
+      00000000000000000000000000000000000000000000009C9C00FFFFFF009CFF
+      FF009CFFFF009CFFFF009CFFFF009CFFFF00FFFFFF00009C9C00009C9C00009C
+      9C00009C9C00009C9C00009C9C00000000000000000000080800000808000008
+      080010FFFF00000808000008080000080800FFFFFF00E7E7E700DE8C7300DE52
+      2100E74A0800D6421000D642100000000000000000000000000084848400FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00009C31009CFFFF00FFFFFF000000
+      00000000000000000000000000000000000000000000319CFF00319CFF00319C
+      FF00319CFF00319CFF0000000000107318004AD67B004AD67B00107318000000
+      0000000000000000000000000000000000000000000000000000009C9C00FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00009C9C0000000000000000000000
+      0000000000000000000000000000000000000000000000000000CE5242000008
+      080010FFFF000008080031313100FFFFFF00FFFFFF00FFFFFF00E7948400F784
+      3900F77B1800EF7342000000000000000000000000000000000084848400FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF009CFFFF00FFFFFF009CFFFF008484
+      8400FFFFFF000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000107318001073180010731800107318000000
+      000000000000000000000000000000000000000000000000000000000000009C
+      9C00009C9C00009C9C00009C9C00009C9C000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000CE5242000008
+      08000008080000080800FFFFFF00F7E7DE00FFE7E700FFE7DE00DE847300EF7B
+      4200F7946B00000000000000000000000000000000000000000084848400FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008484
+      8400000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000CE524200BD6B
+      3900A5522100A5522100E77B4A00F78C5A00F78C5A00F78C5A00DE5A3100E773
+      4200000000000000000000000000000000000000000000000000848484008484
+      8400848484008484840084848400848484008484840084848400848484008484
+      8400000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000008484840084848400848484008484840084848400848484008484
+      8400848484008484840084848400848484000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      000000000000000000000000000000000000000000009C1810009C1810009C18
+      10009C1810009C1810009C1810009C1810009C1810009C1810009C1810009C18
+      10009C1810009C18100000000000000000000000000000000000000000000000
+      0000848484000000000000000000000000000000000000000000000000000000
+      000000000000000000000000000084848400107BCE0029A5E70021B5EF0010AD
+      EF0018ADEF0042ADEF007BB5D60084B5C6000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      000000000000000000000000000000000000000000009C181000FFD6BD00FFE7
+      C600FFE7B500FFDEB500FFDEAD00FFD69C00FFD68C00FFCE8400FFC67B00FFC6
+      7300FFB57B00A531210000000000000000000000000000000000000084000000
+      000084848400FFFFFF00FFFFFF00FFFFFF00C6C6C60000008400C6C6C600FFFF
+      FF00FFFFFF00FFFFFF0000000000848484000084D6006BD6F70052EFFF0039E7
+      FF0039DEFF0039DEFF0021CEFF0010BDF70021ADE70039ADE7008CD6F7000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      000000000000000000000000000000000000000000009C181000FFD6BD00FFEF
+      CE00FFE7C600FFE7B500FFDEB500FFD6AD00FFD69C00FFCE8C00FFCE8400FFC6
+      7B00FFBD8400A5312100000000000000000000000000000084000000FF000000
+      8400C6C6C600C6C6C600C6C6C600C6C6C600000084000000FF0000008400C6C6
+      C600C6C6C600FFFFFF0000000000848484000084D6005ACEFF006BF7FF0052F7
+      FF004AF7FF004AF7FF004AF7FF0042F7FF0042EFFF0031D6FF0031BDF700D6EF
+      FF0000000000000000000000000000000000009C9C0063CECE0063CECE0063CE
+      CE0063CECE0063CECE0063CECE0063CECE0063CECE0063CECE0063CECE0063CE
+      CE0063CECE0063CECE000000000000000000000000009C181000FFDECE00FFF7
+      D600FFEFCE00FFE7C600FFE7B500FFDEB500FFDEAD00FFD69C00FFD68C00FFCE
+      8400FFC68C00AD3129000000000000000000000084000000FF000000FF000000
+      FF0000008400C6C6C600C6C6C600000084000000FF000000FF000000FF000000
+      8400FFFFFF00FFFFFF0000000000848484000094E70018B5F7008CF7FF006BFF
+      FF0063FFFF0063FFFF0063FFFF0063FFFF0063FFFF004AEFFF0039D6F70073CE
+      EF0000000000000000000000000000000000009C9C00CEFFFF009CCEFF009CFF
+      FF009CCEFF009CFFFF009CCEFF009CFFFF009CCEFF009CFFFF009CCEFF009CCE
+      FF009CCEFF0063CECE000000000000000000000000009C181000FFE7D600FFFF
+      E700FFF7D600FFEFCE00FFE7C600FFE7B500FFDEB500FFDEAD00FFD69C00FFCE
+      8C00FFC68C00AD392900000000000000000000000000000084000000FF000000
+      FF000000FF0000008400000084000000FF000000FF000000FF0000008400C6C6
+      C600C6C6C600FFFFFF000000000084848400089CE70010ADF7009CEFFF008CFF
+      FF007BFFFF0073FFFF0073FFFF0073FFFF0073FFFF005AF7FF006BEFFF005ACE
+      EF0000000000000000000000000000000000009C9C00CEFFFF009CFFFF009CFF
+      FF009CFFFF009CCEFF009CFFFF009CCEFF009CFFFF009CCEFF009CFFFF009CCE
+      FF009CCEFF0063CECE000000000000000000000000009C181000FFEFDE00FFFF
+      EF00FFFFE700FFF7D600FFEFCE00FFE7BD00FFE7B500FFDEB500FFDEAD00FFD6
+      9C00FFCE9C00B539290000000000000000000000000000000000000084000000
+      FF000000FF000000FF000000FF000000FF000000FF0000008400C6C6C600C6C6
+      C600C6C6C600FFFFFF000000000084848400109CE70021C6FF0039C6F70063DE
+      F70084EFFF009CF7FF00ADFFFF00A5FFFF009CFFFF0073F7FF0084EFFF008CE7
+      F700B5DEF700000000000000000000000000009C9C00CEFFFF009CFFFF009CFF
+      FF009CFFFF009CFFFF009CFFFF009CFFFF009CCEFF009CFFFF009CCEFF009CFF
+      FF009CCEFF0063CECE000000000000000000000000009C181000FFEFEF00FFFF
+      FF00FFFFEF00FFFFE700FFF7D600FFEFCE00FFEFC600FFE7B500FFDEB500FFDE
+      AD00FFCEA500B542310000000000000000000000000000000000000000000000
+      84000000FF000000FF000000FF000000FF0000008400C6C6C600C6C6C600FFFF
+      FF00FFFFFF00FFFFFF00000000008484840010A5E70042E7FF0031DEFF0029CE
+      F70021BDEF0031BDEF008CDEF700CEFFFF00BDFFFF008CF7FF0063C6CE004A9C
+      73005AB5C600000000000000000000000000009C9C00CEFFFF009CFFFF009CFF
+      FF009CFFFF009CFFFF009CFFFF009CCEFF009CFFFF009CCEFF009CFFFF009CCE
+      FF009CFFFF0063CECE000000000000000000000000009C181000FFF7EF00FFFF
+      FF00FFFFFF00FFFFEF00FFFFE700FFF7D600FFEFCE00FFE7BD00FFE7B500FFDE
+      B500FFCEAD00BD4A390000000000000000000000000000000000000000000000
+      84000000FF000000FF000000FF000000FF0000008400C6C6C600FFFFFF00C6C6
+      C600C6C6C600FFFFFF00000000008484840018B5EF005AFFFF0063FFFF0063FF
+      FF0063FFFF005AFFFF0031CEF70021B5E70008BDEF00009CBD000084210000AD
+      2100108442009CD6D6000000000000000000009C9C00CEFFFF009CFFFF009CFF
+      FF009CFFFF009CFFFF009CFFFF009CFFFF009CFFFF009CFFFF009CCEFF009CFF
+      FF009CCEFF0063CECE000000000000000000000000009C181000FFF7EF00FFFF
+      FF00FFFFFF00FFFFFF00FFFFF700FFFFE700FFF7D600FFEFCE00FFE7C600FFE7
+      B500FFCEAD00BD4A310000000000000000000000000000000000000084000000
+      FF000000FF000000FF000000FF000000FF000000FF0000008400C6C6C600FFFF
+      FF00C6C6C600FFFFFF00000000008484840021B5EF0073FFFF0073FFFF0073FF
+      FF0094FFFF0094FFFF0084FFFF0073FFFF0039DED600007B390000C6310000F7
+      520000BD3900529C73000000000000000000009C9C00CEFFFF009CFFFF009CFF
+      FF009CFFFF009CFFFF009CFFFF009CFFFF009CFFFF009CCEFF009CFFFF009CCE
+      FF009CFFFF0063CECE000000000000000000000000009C181000FFF7EF00FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF00FFFFEF00FFFFE700FFF7D600FFEFCE00FFD6
+      B500FFB59C00BD4A3100000000000000000000000000000084000000FF000000
+      FF000000FF0000008400000084000000FF000000FF000000FF0000008400C6C6
+      C600FFFFFF00FFFFFF00000000008484840031B5E70094EFFF007BF7FF008CF7
+      FF006BD6F70073CEF7007BCEF70073CEEF00298C4A000084100000D6390000F7
+      4A0000DE420000A5290084AD8C0000000000009C9C00CEFFFF009CFFFF009CFF
+      FF009CFFFF009CFFFF009CFFFF009CFFFF009CFFFF009CFFFF009CFFFF009CFF
+      FF009CCEFF0063CECE000000000000000000000000009C181000FFF7EF00FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFEF00FFEFDE00F7BDAD00F784
+      8400F7636300C63929000000000000000000000084000000FF000000FF000000
+      FF0000008400FFFFFF00FFFFFF00000084000000FF000000FF000000FF000000
+      8400848484008484840000000000848484007BCEF70039BDEF004AC6F70052C6
+      F7009CDEF700000000000000000000000000000000000000000018AD290000DE
+      3900189C310084B584000000000000000000009C9C00CEFFFF00CEFFFF00CEFF
+      FF00CEFFFF00CEFFFF00CEFFFF00CEFFFF00CEFFFF00CEFFFF00CEFFFF00CEFF
+      FF009CFFFF0063CECE000000000000000000000000009C181000FFF7EF00FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00EFCEBD009C1810009C18
+      10009C1810009C181000000000000000000000000000000084000000FF000000
+      8400C6C6C600FFFFFF00FFFFFF00FFFFFF00000084000000FF00000084008484
+      8400000000000000000000000000000000000000000000000000000000000000
+      000000000000000000000000000000000000000000000000000021A5290000C6
+      29004AA55200000000000000000000000000009C9C0063CECE0063CECE0063CE
+      CE0063CECE0063CECE0063CECE0063CECE00009C9C00009C9C00009C9C00009C
+      9C00009C9C00009C9C000000000000000000000000009C181000FFF7EF00FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00EFCEC6009C181000FF94
+      21009C1810000000000000000000000000000000000000000000000084000000
+      000084848400FFFFFF00FFFFFF00FFFFFF00C6C6C60000008400FFFFFF008484
+      8400FFFFFF000000000000000000000000000000000000000000000000000000
+      000000000000000000000000000000000000000000006B9C6B00009C08000094
+      18009CC69C0000000000000000000000000000000000009C9C00F7F7F700CEFF
+      FF00CEFFFF009CFFFF009CFFFF00009C9C000000000000000000000000000000
+      000000000000000000000000000000000000000000009C181000FFF7E700FFF7
+      EF00FFF7EF00FFF7EF00FFEFE700FFEFE700FFEFE700EFB5AD009C1810009C18
+      1000000000000000000000000000000000000000000000000000000000000000
+      000084848400FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008484
+      8400000000000000000000000000000000000000000000000000000000000000
+      000000000000000000000000000000000000297B3100007300001084180084B5
+      8C00000000000000000000000000000000000000000000000000009C9C00009C
+      9C00009C9C00009C9C00009C9C00000000000000000000000000000000000000
+      000000000000000000000000000000000000000000009C1810009C1810009C18
+      10009C1810009C1810009C1810009C1810009C1810009C1810009C1810000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000848484008484840084848400848484008484840084848400848484008484
+      8400000000000000000000000000000000000000000000000000000000000000
+      000000000000000000004A845200005A0000005A0000187B2100000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      000000000000000000000000000000000000424D3E000000000000003E000000
+      2800000040000000600000000100010000000000000300000000000000000000
+      000000000000000000000000FFFFFF0000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      00000000000000000000000000000000807F807FE00100005E074E07E0010000
+      00F300F3E00100008009800F80010000800080028001000080008002C0010000
+      80028002E001000080008002E001000080008002C00100008001800280010000
+      800080008001000000000001E001000000010000E003000000000000E0070000
+      4189410DE00F0000BE37BE33FFFF0000FFFFFFFFFFFFF00080018001F801F000
+      80018001F801F000800180018001F000800180018001F000800180018001F000
+      800180018001E000800180018001C00080018001800180008001800180010000
+      80018001800100008001800180010000800180018007000180018001801F1003
+      80018001803F3007FFFFFFFF807FF00FFFFFFFFFFFFFFFFF83FF801FE007FFFF
+      803F0000E007FF00800F0000E007300080070000E0078F8080070000E007C7FF
+      80030000E007E1FF80030000E007E0FF80010000E007F03F80018000E007F83F
+      80018000E007FC0F8007FC00E00FFC0F800FFC01E00FFF03FE1FFC03E00FFF03
+      FF3FFC07E00FFFFFFFFFFFFFFFFFFFFFFFFFC001C001FFFFFFFFC001C00183FF
+      E000C001C001803FC000C001C001800FC000C001C00180078000C001C0018007
+      8000C001C00180030000C001C00180030000C001C00180010000C001C0018001
+      80008001C001800180008001C001801F80018001C001821FC07FC003C003FE1F
+      E0FFC007C007FFFFFFFFC00FC00FFFFFFFFFF800FFFFFFFF8003F00000FFFFFF
+      8003D000001F800180038000000F000180030000000F000180038000000F0001
+      8003C000000700018003E000000700018003E000000300018003C00000030001
+      80038000000100018003000007C3000180038001FFC700038007D003FF87807F
+      800FF007FF0FC0FF801FF00FFC3FFFFF00000000000000000000000000000000
+      000000000000}
+  end
+  object ActionList: TActionList
+    Images = ilstProject
+    Left = 208
+    Top = 126
+    object actnDelete: TAction
+      Caption = #21024#38500
+      ImageIndex = 1
+      OnExecute = actnDeleteExecute
+      OnUpdate = actnDeleteUpdate
+    end
+    object actnRename: TAction
+      Caption = #37325#21629#21517
+      ImageIndex = 11
+      OnExecute = actnRenameExecute
+      OnUpdate = actnDeleteUpdate
+    end
+    object actnImport: TAction
+      Caption = #23548#20837
+      ImageIndex = 7
+      OnExecute = actnImportExecute
+    end
+    object actnExport: TAction
+      Caption = #23548#20986
+      ImageIndex = 8
+      OnExecute = actnExportExecute
+      OnUpdate = actnDeleteUpdate
+    end
+    object actnCloseLib: TAction
+      Caption = #20851#38381#28165#21333
+      OnExecute = actnCloseLibExecute
+      OnUpdate = actnDeleteUpdate
+    end
+  end
+  object PopupMenu: TPopupMenu
+    AutoHotkeys = maManual
+    Images = ilstProject
+    Left = 208
+    Top = 166
+    object actnDelete1: TMenuItem
+      Action = actnDelete
+    end
+    object actnRename1: TMenuItem
+      Action = actnRename
+    end
+    object actnImport1: TMenuItem
+      Action = actnImport
+    end
+    object actnExport1: TMenuItem
+      Action = actnExport
+    end
+  end
+end

+ 294 - 0
AF/StdLibsManagerFrm.pas

@@ -0,0 +1,294 @@
+unit StdLibsManagerFrm;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, ImgList, ComCtrls, ToolWin, ZJGrid, ScStdBillsCtrl, ActnList,
+  Menus, ConstMethodUnit, ConstVarUnit;
+
+type
+  TStdLibsManagerForm = class(TForm)
+    zgLibs: TZJGrid;
+    ToolBar1: TToolBar;
+    ToolButton1: TToolButton;
+    ToolButton2: TToolButton;
+    ToolButton3: TToolButton;
+    ToolButton4: TToolButton;
+    ilstProject: TImageList;
+    ActionList: TActionList;
+    PopupMenu: TPopupMenu;
+    actnDelete: TAction;
+    actnRename: TAction;
+    actnImport: TAction;
+    actnExport: TAction;
+    actnDelete1: TMenuItem;
+    actnRename1: TMenuItem;
+    actnImport1: TMenuItem;
+    actnExport1: TMenuItem;
+    actnCloseLib: TAction;
+    procedure FormCreate(Sender: TObject);
+    procedure actnDeleteExecute(Sender: TObject);
+    procedure actnRenameExecute(Sender: TObject);
+    procedure zgLibsCellTextChanging(Sender: TObject; const ACoord: TPoint;
+      var NewValue: String; var Accept: Boolean);
+    procedure actnDeleteUpdate(Sender: TObject);
+    procedure actnCloseLibExecute(Sender: TObject);
+    procedure actnImportExecute(Sender: TObject);
+    procedure actnExportExecute(Sender: TObject);
+  private
+    { Private declarations }
+    FStdBillsCtrl: TStdBillsCtrl;
+    FLoading: Boolean;
+
+    procedure InitLibs;
+    procedure AddNewLibToGrid(const aLibName: string; aFileFlag: Integer);
+    procedure ReNameLib(const aOldName, aNewName: string; aFileFlag: Integer);
+    procedure SetStdBillsCtrl(const Value: TStdBillsCtrl);
+  public
+    { Public declarations }
+    property StdBillsCtrl: TStdBillsCtrl read FStdBillsCtrl write SetStdBillsCtrl;
+  end;
+
+
+
+implementation
+
+uses
+  FXQDManagerUnit,
+  NewProjectFrm;
+
+{$R *.dfm}
+
+procedure TStdLibsManagerForm.FormCreate(Sender: TObject);
+begin
+  FLoading := True;
+  zgLibs.ColWidths[1] := 220;
+  zgLibs.ColWidths[2] := 120;
+
+  zgLibs.TextAligns.Cols[1] := gaCenterLeft;
+  zgLibs.TextAligns.Cols[2] := gaCenterCenter;
+
+  zgLibs.Cells[1, 0].Text := '츰냔';
+  zgLibs.Cells[2, 0].Text := '잚謹';
+
+  zgLibs.Cells[1, 0].TextAlign := gaCenterCenter;
+  FLoading := False;
+end;
+
+procedure TStdLibsManagerForm.InitLibs;
+var
+  I: Integer;
+  sLib: string;
+  sFlag: string;
+begin
+  FLoading := True;
+  with FStdBillsCtrl.FXQDManager.ConfigFileManager do
+    for I := 0 to Libs.Count - 1 do
+    begin
+      sLib := Libs[I];
+      sFlag := Copy(sLib, 1, Pos('.', sLib) - 1);
+      sLib := Copy(sLib, Pos('.', sLib) + 1, Length(sLib));
+      zgLibs.Cells[1, I + 1].Text := sLib;
+      if sFlag = '1' then
+        zgLibs.Cells[2, I + 1].Text := '롸淃헌데';
+    end;
+  FLoading := False;
+end;
+
+procedure TStdLibsManagerForm.SetStdBillsCtrl(const Value: TStdBillsCtrl);
+begin
+  FStdBillsCtrl := Value;
+  if FStdBillsCtrl <> nil then
+    InitLibs;
+end;
+
+procedure TStdLibsManagerForm.actnDeleteExecute(Sender: TObject);
+var
+  iFileFlag: Integer;
+  sLibName: string;
+begin
+  if not MessageQuest(sDeleteLib) then Exit;
+
+  sLibName := zgLibs.Cells[1, zgLibs.CurRow].Text;
+  if sLibName = '' then Exit;
+
+  if SameText(FStdBillsCtrl.StdBillsLibFrm.OpenLibName, sLibName) then
+  begin
+    MessageError(Screen.ActiveForm.Handle, '匡숭綠굳댔역,헝邱밑균匡숭疼�뇜!');
+    Exit;
+  end;
+
+  if SameText(zgLibs.Cells[2, zgLibs.CurRow].Text, '롸淃헌데') then
+    iFileFlag := 1;
+
+  FStdBillsCtrl.FXQDManager.DeleteFile(sLibName);
+  FStdBillsCtrl.StdBillsLibFrm.DeleteLib(sLibName, iFileFlag);
+
+  zgLibs.DeleteRow(zgLibs.CurRow);
+end;
+
+procedure TStdLibsManagerForm.actnRenameExecute(Sender: TObject);
+var
+  iFileFlag: Integer;
+  sOldLibName: string;
+  sNewLibName: string;
+begin
+  sOldLibName := zgLibs.Cells[1, zgLibs.CurRow].Text;
+  if sOldLibName = '' then Exit;
+  if SameText(FStdBillsCtrl.StdBillsLibFrm.OpenLibName, sOldLibName) then
+  begin
+    MessageError(Screen.ActiveForm.Handle, '匡숭綠굳댔역,헝邱밑균匡숭疼路츱츰!');
+    Exit;
+  end;
+
+  if SameText(zgLibs.Cells[2, zgLibs.CurRow].Text, '롸淃헌데') then
+    iFileFlag := 1;
+
+  sNewLibName := sOldLibName;
+  while ScInputQuery('깃硫헌데', '헌데츰냔', sNewLibName) do
+  begin
+    if not CheckSpecialChar(sNewLibName) then
+    begin
+      if not FStdBillsCtrl.FXQDManager.CheckLibExists(sNewLibName) then
+      begin
+        zgLibs.Cells[1, zgLibs.CurRow].Text := sNewLibName;
+        ReNameLib(sOldLibName, sNewLibName, iFileFlag);
+        Break;
+      end
+      else
+      begin
+        sNewLibName := sOldLibName;
+        MessageWarning(Screen.ActiveForm.Handle, sSameFileName);
+      end;
+    end
+    else
+    begin
+      sNewLibName := sOldLibName;
+      MessageWarning(Screen.ActiveForm.Handle, sSpecialChar);
+    end;
+  end;
+end;
+
+procedure TStdLibsManagerForm.zgLibsCellTextChanging(Sender: TObject;
+  const ACoord: TPoint; var NewValue: String; var Accept: Boolean);
+var
+  sOldLibName: string;
+  iFileFlag: Integer;
+begin
+  if FLoading then Exit;
+  
+  Accept := False;
+  if ACoord.X <> 1 then Exit;
+  sOldLibName := zgLibs.Cells[1, zgLibs.CurRow].Text;
+  if sOldLibName = '' then Exit;
+  if SameText(zgLibs.Cells[2, zgLibs.CurRow].Text, '롸淃헌데') then
+    iFileFlag := 1;
+      
+  if not CheckSpecialChar(NewValue) then
+  begin
+    if not FStdBillsCtrl.FXQDManager.CheckLibExists(NewValue) then
+    begin
+      Accept := True;
+      ReNameLib(sOldLibName, NewValue, iFileFlag);
+    end
+    else
+      MessageWarning(Screen.ActiveForm.Handle, sSameFileName);
+  end
+  else
+    MessageWarning(Screen.ActiveForm.Handle, sSpecialChar);
+end;
+
+procedure TStdLibsManagerForm.ReNameLib(const aOldName, aNewName: string;
+  aFileFlag: Integer);
+begin
+  FStdBillsCtrl.FXQDManager.RenameFile(aOldName, aNewName);
+  FStdBillsCtrl.StdBillsLibFrm.ReNameLib(aOldName, aNewName, aFileFlag);
+end;
+
+procedure TStdLibsManagerForm.actnDeleteUpdate(Sender: TObject);
+begin
+  TAction(Sender).Enabled := zgLibs.Cells[1, zgLibs.CurRow].Text <> '';
+end;
+
+procedure TStdLibsManagerForm.actnCloseLibExecute(Sender: TObject);
+var
+  iFileFlag: Integer;
+begin
+  if SameText(zgLibs.Cells[2, zgLibs.CurRow].Text, '롸淃헌데') then
+    iFileFlag := 1;
+
+  Screen.Cursor := crHourGlass;
+  try
+    FStdBillsCtrl.StdBillsLibFrm.CloseLib(iFileFlag);
+  finally
+    Screen.Cursor := crDefault;
+  end;
+end;
+
+procedure TStdLibsManagerForm.actnImportExecute(Sender: TObject);
+var
+  iFileFlag: Integer;
+  sFileName: string;
+  sLibName: string;
+  sNewLibName: string;
+begin
+  if OpenFileDialog('돔흙', '.dat', '', 'files (*.dat)|*.dat', sFileName) then
+  begin
+    sLibName := ExtractFileNameWithoutExt(sFileName);
+    sNewLibName := sLibName;
+    while InputStdLibName(sNewLibName, iFileFlag) do
+    begin
+      if sNewLibName <> '' then
+      begin
+        if not FStdBillsCtrl.FXQDManager.CheckLibExists(sNewLibName) then
+        begin
+          FStdBillsCtrl.FXQDManager.ImportLib(sFileName, sNewLibName);
+          FStdBillsCtrl.StdBillsLibFrm.AddLib(sNewLibName, iFileFlag);
+          AddNewLibToGrid(sNewLibName, iFileFlag);
+          Break;
+        end
+        else
+        begin
+          sNewLibName := sLibName;
+          MessageError(Screen.ActiveForm.Handle, sSameFileName);
+        end;
+      end
+      else
+      begin
+        sNewLibName := sLibName;
+        MessageError(Screen.ActiveForm.Handle, sNameNotNull);
+      end;
+    end;
+  end;
+end;
+
+procedure TStdLibsManagerForm.AddNewLibToGrid(const aLibName: string;
+  aFileFlag: Integer);
+var
+  iRow: Integer;
+begin
+  FLoading := True;
+  iRow := FStdBillsCtrl.FXQDManager.ConfigFileManager.Libs.Count + zgLibs.FixedRowCount - 1;
+  zgLibs.Cells[1, iRow].Text := aLibName;
+  if aFileFlag = 1 then
+    zgLibs.Cells[2, iRow].Text := '롸淃헌데'
+  else
+    zgLibs.Cells[2, iRow].Text := '묏넋좆헌데';
+  FLoading := False;
+end;
+
+procedure TStdLibsManagerForm.actnExportExecute(Sender: TObject);
+var
+  sLibName: string;
+  sFileName: string;
+begin
+  sLibName := zgLibs.Cells[1, zgLibs.CurRow].Text;
+  if SaveFileDialog(sExportTip, '.dat', sLibName, '헌데긍齡 (*.dat)|*.dat', sFileName) then
+  begin
+    sLibName := FStdBillsCtrl.FXQDManager.GenerateLibName(sLibName);
+    FStdBillsCtrl.FXQDManager.ExportLib(sLibName, sFileName);
+  end;
+end;
+
+end.

+ 18 - 0
AF/beProgressFrm.dfm

@@ -0,0 +1,18 @@
+object frmProgressor: TfrmProgressor
+  Left = 353
+  Top = 364
+  BorderStyle = bsNone
+  ClientHeight = 72
+  ClientWidth = 529
+  Color = clBtnFace
+  Font.Charset = ANSI_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -12
+  Font.Name = #23435#20307
+  Font.Style = []
+  FormStyle = fsStayOnTop
+  OldCreateOrder = False
+  Position = poMainFormCenter
+  PixelsPerInch = 96
+  TextHeight = 12
+end

+ 37 - 0
AF/beProgressFrm.pas

@@ -0,0 +1,37 @@
+unit beProgressFrm;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, ExtCtrls, StdCtrls;
+
+type
+  TfrmProgressor = class(TForm)
+  private
+    { Private declarations }
+  public
+    procedure SetMax(aMax: Integer);
+    procedure AddStep(aStep: Integer; const aText: string = '');
+  end;
+
+implementation
+
+{$R *.dfm}
+
+{ TfrmProgressor }
+
+procedure TfrmProgressor.AddStep(aStep: Integer; const aText: string);
+begin
+//  cpbProgress.Position := cpbProgress.Position + aStep;
+//  lbeHint.Caption := aText;
+//  Application.ProcessMessages;
+end;
+
+procedure TfrmProgressor.SetMax(aMax: Integer);
+begin
+//  cpbProgress.Position := 0;
+//  cpbProgress.Max := aMax;
+end;
+
+end.

+ 20 - 0
CU/CommonIntfUnit.pas

@@ -0,0 +1,20 @@
+unit CommonIntfUnit;
+
+interface
+
+type
+  IFileManager = Interface
+
+    ['{F7F25EF0-C472-4612-B29A-D193E6528305}']
+
+    procedure LoadFromFile(const aFileName: string);
+    procedure SaveToFile(const aFileName: string);
+
+    procedure AddFile(const aFileName: string);
+    procedure DeleteFile(const aFileName: string);
+    procedure RenameFile(const aOldFileName, aNewFileName: string);
+  end;
+
+implementation
+
+end.

Разница между файлами не показана из-за своего большого размера
+ 1478 - 0
CU/ConstMethodUnit.pas


+ 164 - 0
CU/ConstTypeUnit.pas

@@ -0,0 +1,164 @@
+unit ConstTypeUnit;
+
+interface
+
+uses
+  Classes;
+
+type
+  { ptBudgetEstimate: 概算,ptEstimate1: 建议估算 ptEstimate2: 可行性估算 ptBillsBudget: 清单预算 ptFinal: 决算} // 2012.3.1 HXY新加 ptBillsBudget, ptFinal两个字段
+  TScProjType = (ptBills, ptBudget, ptBudgetEstimate, ptEstimate2, ptEstimate1, ptBillsBudget, ptFinal);
+
+  TOpenType = (otNew, otOpen);
+
+  TBidLotOperation = (boAdd, boDelete, boReName);
+
+  TFormType = (ftImportStdLib, ftImportSmb);
+
+  {Internal Save DataStruct}
+
+  TBillsOrderItem = class
+  private
+    FID: Integer;
+    FMajorIndex: Integer;
+    FCharpterID: Integer;
+    FHasChildren: Boolean;
+  public
+    property ID: Integer read FID write FID;
+    property MajorIndex: Integer read FMajorIndex write FMajorIndex;
+    property CharpterID: Integer read FCharpterID write FCharpterID;
+    property HasChildren: Boolean read FHasChildren write FHasChildren;
+  end;
+
+  // Modified By MaiXinRong 2012-03-19 第二部分中800章的数量与单价
+  TFloatItem = class
+  public
+    Quantity2: Double;
+    UnitPrice2: Double;
+  end;
+
+  {Copy Bills -------Paste Bills}
+
+  TBillIDRecord = class
+  private
+    FOldID: Integer;
+    FNewID: Integer;
+    FParentID: Integer;
+    FNextSiblingID: Integer;
+    FParentChanged: Boolean;
+    FNextSiblingChanged: Boolean;
+
+    FCode: string;
+    FName: string;
+    FUnits: string;
+    FMemoStr: string;
+
+    FQuantity: Double;
+    FQuantity2: Double;
+
+    FUnitPrice: Currency;
+    FTotalPrice: Currency;
+    FUnitPrice2: Currency;
+    FTotalPrice2: Currency;
+
+    FB_Code: string;
+    FDesignQuantity: Currency;
+    FDesignQuantity2: Currency;
+    FDesignPrice: Currency;
+
+    FList: TList;
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    property OldID: Integer read FOldID write FOldID;
+    property NewID: Integer read FNewID write FNewID;
+    property ParentID: Integer read FParentID write FParentID;
+    property NextSiblingID: Integer read FNextSiblingID write FNextSiblingID;
+    property ParentChanged: Boolean read FParentChanged write FParentChanged;
+    property NextSiblingChanged: Boolean read FNextSiblingChanged write FNextSiblingChanged;
+    property Code: string read FCode write FCode;
+    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 MemoStr: string read FMemoStr write FMemoStr;
+    property Quantity: Double read FQuantity write FQuantity;
+    property Quantity2: Double read FQuantity2 write FQuantity2;
+    property UnitPrice: Currency read FUnitPrice write FUnitPrice;
+    property TotalPrice: Currency read FTotalPrice write FTotalPrice;
+    property UnitPrice2: Currency read FUnitPrice2 write FUnitPrice2;
+    property TotalPrice2: Currency read FTotalPrice2 write FTotalPrice2;
+    property DesignQuantity: Currency read FDesignQuantity write FDesignQuantity;
+    property DesignQuantity2: Currency read FDesignQuantity2 write FDesignQuantity2;
+    property DesignPrice: Currency read FDesignPrice write FDesignPrice;
+
+    property List: TList read FList;
+  end;
+
+  TDQRecord = class
+  private
+    FName: string;
+    FUnits: string;
+    FDQuantity: Double;
+    FDQuantity2: Double;
+    FMemostr: string;
+  public
+    property Name: string read FName write FName;
+    property Units: string read FUnits write FUnits;
+    property DQuantity: Double read FDQuantity write FDQuantity;
+    property DQuantity2: Double read FDQuantity2 write FDQuantity2;
+    property MemoStr: string read FMemostr write FMemostr;
+  end;
+
+  {Bills Position}
+
+  PIDRecord = ^TIDRecord;
+  TIDRecord = record
+    PreID: Integer;  // 前兄弟ID
+    NextID: Integer; // 后兄弟ID
+  end;
+
+
+  { Third Part Bills }
+  
+  PBillsConfigRecord = ^TBillsConfigRecord;
+  TBillsConfigRecord = record
+    ID: Integer;
+    ParentID: Integer;
+    NextID: Integer;
+    Code: string;
+    BCode: string;
+    Name: string;
+    Units: string;
+    Exprs: string;
+    IsPreDefine: Boolean;
+    ParentModified: Boolean;
+    NextModified: Boolean;
+  end;
+  
+
+  {All kinds of Events}
+  TInternalEvent = procedure of object;
+  TControlUIEvent = procedure (AEnabled: Boolean; AETree: Boolean = True) of object;
+  TOpenProjectProc = procedure (const aName, aShortName: string; aProjType, aID: Integer) of object;
+
+implementation
+
+uses
+  ConstMethodUnit;
+
+{ TBillIDRecord }
+
+constructor TBillIDRecord.Create;
+begin
+  FList := TList.Create;
+end;
+
+destructor TBillIDRecord.Destroy;
+begin
+  ClearObjectList(FList);
+  FList.Free;
+  inherited;
+end;
+
+end.

+ 313 - 0
CU/ConstVarUnit.pas

@@ -0,0 +1,313 @@
+unit ConstVarUnit;
+
+interface
+
+uses Messages;
+
+const
+  {SoftWare Name}
+
+  SoftWareName_ZY_Common  = '纵横公路工程0号台账清单编审软件(专业版)';
+  SoftWareName_ZY         = '纵横清单编制管理系统(专业版)';//'广东三级清单编制软件';
+  SoftWareName_XX         = '纵横清单编制管理系统(学习版)';
+  SoftWareName_OnLine     = '纵横清单编制管理系统(网络版)';
+
+  {serve phone}
+  
+  LoadAuthorizePhone      = '0756-3850888';
+  LoadServicePhone        = '0756-3850888';
+
+  {TemplateFiles}
+
+  BillsTemplateFile       = 'BillsTemplete.bmf';
+  BudgetTemplateFile      = 'BudgetTemplete.bmf';
+  FXTemplateFile          = 'FXTemplate.dat';
+
+
+  {DataBase Fields ************** Begin ******************}
+  
+  {Bills}
+
+  SID                     = 'ID';
+  sParentID               = 'ParentID';
+  sNextSiblingID          = 'NextSiblingID';
+  sBillsID                = 'BillsID';
+  STotalPrice             = 'TotalPrice';
+  STenderTotalPrice       = 'TenderTotalPrice';
+  sName                   = 'Name';
+  sUnits                  = 'Units';
+  sCode                   = 'Code';
+  sB_Code                 = 'B_Code';
+  sIsLeaf                 = 'IsLeaf';
+  sBillsCode              = 'BillsCode';
+  sMemoStr                = 'MemoStr';
+  sOwnerName              = 'OwnerName';
+  sQuantity               = 'Quantity';
+  sQuantity2              = 'Quantity2';
+  sUnitPrice              = 'UnitPrice';
+  sDesignQuantity         = 'DesignQuantity';
+  sDesignQuantity2        = 'DesignQuantity2';
+  sDesignPrice            = 'DesignPrice';
+  sIsPreDefine            = 'IsPreDefine';
+
+  {dqCalcExpression}
+
+  sDQID                   = 'DQID';
+
+  {HisResPoint}
+
+  sCreateTime             = 'CreateTime';
+
+  {Exprs}
+
+  SMajorMinorRecdID       = 'MajorID;MinorID;RecdID';
+  SMajorRecdID            = 'MajorID;RecdID';
+
+  Exprs_Bills_ID          = 1;
+  Exprs_DrawQty_ID        = 2;
+
+  Exprs_Qty_ID            = 1;
+  Exprs_DQty_ID           = 4;
+  Exprs_DQty2_ID          = 5;
+
+  {DrawingQuantity}
+
+  sDQuantity1             = 'DQuantity1';
+  sDQuantity2             = 'DQuantity2';
+  sMemoContext            = 'MemoContext';
+  sSerinalNo              = 'SerinalNo';
+
+  {ProjProperty}
+
+  sProjType               = 'PROJTYPE';
+
+  { Bills ID }
+
+  GYTotalPriceID          = 5;
+  GLBaseCost              = 6;
+
+  {************************** End *******************************}
+
+  
+  {Message Hint Words}
+
+  sInputFileName          = '输入文件名称';
+  sNameNotNull            = '名称不能为空,请重新输入!';
+  sSameFileName           = '已存在同名文件,请重新输入!';
+  sSpecialChar            = '文件名不能包含特殊字符(/ \ : * ? " < > |)!';
+  sGatherError            = '汇总出错,可能打勾位置不正确!';
+  sMergeProjectHint       = '选择操作:' + #13#10 + '  1. 确定: 覆盖建设项目;' + #13#10 + '  2. 取消: 先导出建设项目,再覆盖.';
+  sSplitProjectHint       = '选择操作:' + #13#10 + '  1. 确定: 覆盖标段;' + #13#10 + '  2. 取消: 先导出建设项目,再覆盖.';
+
+  sQuestTip               = '询问';
+  sErrorTip               = '错误';
+  sExportTip              = '导出';
+  sImportTip              = '导入';
+
+  sImportExcelHint        = '导入Excel会覆盖原来清单,是否继续?';
+  sDeleteBillsHint        = '确定要删除该清单项及其下面的所有子项吗?';
+  sDeleteLib              = '确定要删除该标准清单吗?';
+  sRemoveBillsZeorQty     = '确定要删除(工程量和单价 = 0)的所有清单吗?';
+  sClearBillsQtyHint      = '确定要清空当前清单及其子项的工程量, 以及它们底下的所有图纸工程量的数量吗?';
+  sLoginFailed            = '登录服务器失败,程序即将关闭。';
+
+  sWelcomeText            = '欢迎使用纵横软件!!!';
+
+  {Status Words}
+
+  sNewWord                = '正在新建文件';
+  sOpenWord               = '正在打开文件';
+  sSaveWord               = '正在保存文件';
+  sSaveAsWord             = '正在另存文件';
+  sImportExcel            = '正在导入Excel';
+  sGatherWord             = '正在汇总清单';
+  sCopyBills              = '正在复制清单';
+  sExportExcel            = '正在导出Excel';
+  sMergeProject           = '正在合并清单';
+  sSplitProject           = '正在拆分清单';
+  sExportStdLib           = '正在导出分项清单';
+  sInitWord               = '就绪';
+
+
+  {Self Define Messages}
+
+  SM_Base                 = WM_USER + 100;
+  SM_ProgressInc          = SM_Base + 1;
+  SM_StdBillsLib          = SM_Base + 2;
+  SM_CheckProject         = SM_Base + 3;
+  SM_LocateBills          = SM_Base + 4;
+  SM_AutoSaveProjects     = SM_Base + 5;
+
+
+  {Units}
+
+  UnitsArray: array [0..34] of string = (
+                                        'm',
+                                        'km',
+                                        'm2',
+                                        'm3',
+                                        'kg',
+                                        't',
+                                        'm3·km',
+                                        '总额',
+                                        '月',
+                                        '项',
+                                        '处',
+                                        '个',
+                                        '根',
+                                        '棵',
+                                        '块',
+                                        '每一试桩',
+                                        '桥长米',
+                                        '公路公里',
+                                        '株',
+                                        '组',
+                                        '座',
+                                        '元',
+                                        '工日',
+                                        '套',
+                                        '台班',
+                                        '艘班',
+                                        'm/处',
+                                        'm/道',
+                                        'm/座',
+                                        'm2/m',
+                                        'm3/m',
+                                        'm3/处',
+                                        '根/米',
+                                        '亩',
+                                        'm3/m2'
+                                       );
+
+  { project property }
+
+  ArrProjectProperties: array [0..17] of string =
+                                                  (
+                                                    '项目类型',
+                                                    '建设项目',
+                                                    '合同段',
+                                                    '编制范围',
+                                                    '建设单位',
+                                                    '工程地点',
+                                                    '编制日期',
+                                                    '编制人',
+                                                    '编制人证号',
+                                                    '复核人',
+                                                    '复核人证号',
+                                                    '投标人',
+                                                    '数据文件号',
+                                                    '公路等级',
+                                                    '起点桩号',
+                                                    '终点桩号',
+                                                    '路线或桥梁长度(km)',
+                                                    '路线或桥梁宽度(m)'
+                                                  );
+
+  {exprs}                                     
+  ExprsCharSet: set of char = ['0'..'9','(','[','{', ')',']','}', '+','-','*','/','^', '%'];
+//  ExprsCharSet: set of char = ['0'..'9', 'a'..'z', 'A'..'Z', '(','[','{', ')',']','}', '+','-','*','/','^', '%'];
+
+  {Copy Bills}
+
+  c_BillsList             = '清单列表';
+  c_DrawQList             = '图纸列表';
+  c_BillsItem             = '项目';
+  c_DQItem                = '图纸项';
+  c_BillsExprs            = '清单公式列表';
+  c_BillsExprsItem        = '清单公式';
+  c_DrawingExprs          = '图纸公式列表';
+  c_DrawingExprsItem      = '图纸公式';
+  
+  c_ID                    = '序号';
+  c_ParentID              = '父项序号';
+  c_NextSiblingID         = '兄弟序号';
+  c_Code                  = '项目节编号';
+  c_BCode                 = '清单编号';
+  c_Name                  = '名称';
+  c_Units                 = '单位';
+  c_DesignQuantity1       = '设计数量1';
+  c_DesignQuantity2       = '设计数量2';
+  c_DesignPrice           = '经济指标';
+  c_Quantity              = '清单数量';
+  c_Quantity2             = '清单数量2';
+  c_UnitPrice             = '清单单价';
+  c_TotalPrice            = '金额';
+  c_MemoString            = '备注';
+  c_IsGatherQty           = '统计';
+  c_SerinalNo             = '顺序号';
+  c_MajorID               = '主ID';
+  c_MinorID               = '辅ID';
+  c_RecdID                = '记录ID';
+  c_Exprs                 = '表达式';
+  c_Exprs1                = '表达式1';
+  c_Flag                  = '标识';
+  c_ExprsValue            = '值';
+  c_BillsID               = 'BillsID';
+
+
+  {Check Paste Bills Position}
+
+  cp_Next                 = 0;
+  cp_Font                 = 1;
+  cp_Child                = 2;
+
+  {restore point}
+  MaxRPointCount          = 5;
+  sBackUpFolder           = 'BackUpPoints';
+
+  { max rows in trail's version when export bills to excel }
+  MaxExcelRow             = 100;
+
+  {connection string}
+  SAdoConnectStr          = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;User ID=%s;Password=%s;Persist Security Info=True';
+
+  {iniFile}
+  SIniFileName            = 'config.ini';
+  SStandardLibs           = 'StandardLibs';
+  SProjectType            = 'Budget';
+
+  SGeneralOptions         = 'GeneralOptions';
+  SAllowMfyCode           = 'AllowMfyCode';
+  SAutoSaveProjects       = 'AutoSaveProjects';
+  SAutoSaveInterval       = 'AutoSaveInterval';
+  SSaveAllProjects        = 'SaveAllProjects';
+  SSaveRestorePoint       = 'SaveRestorePoint';
+  SAutoCollapse           = 'AutoCollapse';
+  SRealTimeCalc           = 'RealTimeCalc';
+
+  SGatherOptions          = 'GatherOptions';
+  SMatchCodeOnly          = 'MatchCodeOnly';
+
+  {File Ext}
+  
+  STempFileExt            = '.tmp';
+  SBudgetFileExt          = '.smb';
+  SBillsFileExt           = '.smp';
+  SEstimateFileExt        = '.sme';
+
+type
+  // 清单种类:图纸工程量、预算项目节、清单子目号、不区分
+  TBillCategory = (bcTZGCL, bcYSXMJ, bcQDZMH, bcAll);
+  // 错误种类:
+  TErrorCategory = (ecCodeError, ecB_CodeError, ecNameError, ecUnitError,
+                    ecNoQuantity, ecQuantityError,
+                    ecNoDesignQuantity, ecNoDesignQuantity2, ecDesignQuantityPosError, ecRepeatLine,
+                    ecLostChildren, ecLostPreSibling, ecLostNextSibling,
+                    ecSuperscale, ecCodeStep, ecNoUnits);
+
+// “数量错误”公用,用于用户手工指定
+var
+  ErrorHintAry: array[0..15] of string = ('新增预算项目节', '新增清单子目',
+                  '名称错误', '单位错误', '清单数量遗漏', '数量错误',
+                  '设计数量1遗漏', '设计数量2遗漏', '设计数量位置错误',
+                  '重行', '漏子项(漏%d行)', '漏前项(漏%d行)', '漏后项(漏%d行)',
+                  '深度超出', '编号递延', '单位遗漏');
+
+const HintSeparator = ';';
+
+implementation
+
+
+
+
+end.

+ 112 - 0
CU/CustomDoc.pas

@@ -0,0 +1,112 @@
+unit CustomDoc;
+
+interface
+
+uses
+  Classes,
+  SysUtils;
+
+type
+  TProjectFile = class(TComponent)
+  private
+    FID: Integer;
+    FNewID: Integer;
+    FFlag: Integer;
+    FGatherID: Integer;
+    FProjName: string;
+    FFullPath: string;
+  public
+    property NewID: Integer read FNewID write FNewID;
+    property FullPath: string read FFullPath write FFullPath;
+  published
+    property ID: Integer read FID write FID;
+    property Flag: Integer read FFlag write FFlag;
+    property GatherID: Integer read FGatherID write FGatherID;
+    property ProjName: string read FProjName write FProjName;
+  end;
+
+  TAddProjectProc = procedure (aProjFile: TProjectFile; aProjList: TList;
+                               var aFullPath: string) of object;
+
+  TCustomProjectDoc = class
+  public
+    class procedure ImportProjects(const aFileName: string; aAddProc: TAddProjectProc);
+    class procedure ExportProjects(const aFileName: string; aFileList: TList);
+  end;
+
+implementation
+
+{ TCustomProjectDoc }
+
+class procedure TCustomProjectDoc.ExportProjects(const aFileName: string;
+  aFileList: TList);
+var
+  iValue: Integer;
+  iLoop: Integer;
+  strFilePath: string;
+  ProjFile: TProjectFile;
+  FileStream: TFileStream;
+  ProjectStream: TFileStream;
+begin
+  FileStream := TFileStream.Create(aFileName, fmCreate);
+  try
+    iValue := aFileList.Count;
+    // 文件个数
+    FileStream.Write(iValue, SizeOf(iValue));
+    for iLoop := 0 to aFileList.Count - 1 do
+    begin
+      ProjFile := TProjectFile(aFileList.List^[iLoop]);
+      strFilePath := ProjFile.FullPath;
+      // 项目信息
+      FileStream.WriteComponent(ProjFile);
+      // 文件大小
+      ProjectStream := TFileStream.Create(ProjFile.FullPath, fmOpenRead);
+      iValue := ProjectStream.Size;
+      FileStream.Write(iValue, SizeOf(iValue));
+      // 文件内容
+      FileStream.CopyFrom(ProjectStream, iValue);
+      ProjectStream.Free;
+    end;
+  finally
+    FileStream.Free;
+  end;
+end;
+
+class procedure TCustomProjectDoc.ImportProjects(const aFileName: string; aAddProc: TAddProjectProc);
+var
+  iValue: Integer;
+  iLoop: Integer;
+  ProjList: TList;
+  iFileSize: Integer;
+  strFilePath: string;
+  ProjFile: TProjectFile;
+  FileStream: TFileStream;
+  ProjectStream: TFileStream;
+begin
+  ProjList := TList.Create;
+  FileStream := TFileStream.Create(aFileName, fmOpenRead);
+  try
+    // 文件个数
+    FileStream.Read(iValue, SizeOf(iValue));
+    for iLoop := 0 to iValue - 1 do
+    begin
+      //  项目信息
+      ProjFile := TProjectFile.Create(nil);
+      FileStream.ReadComponent(ProjFile);
+      aAddProc(ProjFile, ProjList, strFilePath);
+      // 文件大小
+      FileStream.Read(iFileSize, SizeOf(iFileSize));
+      // 文件内容
+      ProjectStream := TFileStream.Create(strFilePath, fmCreate);
+      ProjectStream.CopyFrom(FileStream, iFileSize);
+      ProjectStream.Free;
+    end;
+  finally
+    FileStream.Free;
+    for iLoop := 0 to ProjList.Count - 1 do
+      TProjectFile(ProjList.List^[iLoop]).Free;
+    ProjList.Free;
+  end;
+end;
+
+end.

+ 516 - 0
CU/ExportDecorateUnit.pas

@@ -0,0 +1,516 @@
+
+{
+  ***************************************
+
+  Note: Add the Third Part Bills when Export .smb File
+
+  **************************************
+}
+
+unit ExportDecorateUnit;
+
+interface
+
+uses
+  Classes,
+  ADODB,
+  DataBase,
+  ConstTypeUnit,
+  Provider,
+  ConstMethodUnit,
+  DBClient,
+  DB,
+  ConstVarUnit,
+  ScFileArchiver;
+
+type
+  TBillsConfig = class
+  private
+    FBillsStrings: TStrings;
+    FRecordList: TList;
+  public
+    constructor Create(const aFileName: string);
+    destructor Destroy; override;
+
+    procedure ResolveStrings;
+
+  end;
+
+  TDecorator = class
+  private
+    FBillsConfig: TBillsConfig;
+  public
+    constructor Create(const aCfgFileName: string);
+    destructor Destroy; override;
+
+    procedure Decorate; virtual; abstract;
+  end;
+
+  TCreateDecorator = class(TDecorator)
+  private
+    FBillsData: TDMDataBase;
+    procedure ClearExprs;
+    procedure Save;
+    procedure WriteBillsAndExprs;
+  public
+    constructor Create(aBillsData: TDMDataBase; const aCfgFileName: string);
+
+    procedure Decorate; override;
+  end;
+
+  TBillsDecorator = class(TDecorator)
+  private
+    FArchiver        : TScProjectFileArchiver;
+    FBillsTable      : TADOTable;
+    FBillsDsp        : TDataSetProvider;
+    FBillsCds        : TClientDataSet;
+    FDrawQtyTable    : TADOTable;
+    FDrawQtyDsp      : TDataSetProvider;
+    FDrawQtyCds      : TClientDataSet;
+    FProjProperty    : TADOTable;
+    FProjPropertyDsp : TDataSetProvider;
+    FProjPropertyCds : TClientDataSet;
+
+    function CanDecorate: Boolean;
+    function MaxBillsID: Integer;
+    function GetMaxProjPropertyID: Integer;
+    procedure ModifyNextID;
+    procedure ModifyItemIDs;
+    procedure AppendBills;
+    procedure ModifyExprs;
+    procedure ModifyProjProperty;
+    procedure ModifyIsCreatePriceAnalysis;
+  public
+    constructor Create(const aArFileName, aCfgFileName: string); overload;
+    destructor Destroy; override;
+
+    procedure Decorate; override;
+  end;
+
+implementation
+
+uses SysUtils, ScExprsDM;
+
+{ TBillsConfig }
+
+constructor TBillsConfig.Create(const aFileName: string);
+begin
+  FBillsStrings := TStringList.Create;
+  FRecordList := TList.Create;
+
+  FBillsStrings.LoadFromFile(aFileName);
+end;
+
+destructor TBillsConfig.Destroy;
+begin
+  FBillsStrings.Free;
+  ClearPointerList(FRecordList);
+  FRecordList.Free;
+  inherited;
+end;
+
+procedure TBillsConfig.ResolveStrings;
+var
+  iLoop   : Integer;
+
+  iID     : Integer;
+  iErrCode: Integer;
+
+  sBills: string;
+  sChain: string;
+  rdBillsConfig: PBillsConfigRecord;
+begin
+  for iLoop := 0 to FBillsStrings.Count - 1 do
+  begin
+    sBills := FBillsStrings[iLoop];
+    if sBills = '' then Continue;
+    
+    New(rdBillsConfig);
+
+    sChain := Copy(sBills, 1, Pos(',', sBills) - 1);
+    sBills := Copy(sBills, Pos(',', sBills) + 1, Length(sBills));
+
+    Val(sChain, iID, iErrCode);
+    rdBillsConfig.ID := iID;
+
+    sChain := Copy(sBills, 1, Pos(',', sBills) - 1);
+    sBills := Copy(sBills, Pos(',', sBills) + 1, Length(sBills));
+
+    Val(sChain, iID, iErrCode);
+    rdBillsConfig.ParentID := iID;
+
+    sChain := Copy(sBills, 1, Pos(',', sBills) - 1);
+    sBills := Copy(sBills, Pos(',', sBills) + 1, Length(sBills));
+
+    Val(sChain, iID, iErrCode);
+    rdBillsConfig.NextID := iID;    
+
+    sChain := Copy(sBills, 1, Pos(',', sBills) - 1);
+    sBills := Copy(sBills, Pos(',', sBills) + 1, Length(sBills));
+
+    rdBillsConfig.Code := Trim(sChain);
+
+    sChain := Copy(sBills, 1, Pos(',', sBills) - 1);
+    sBills := Copy(sBills, Pos(',', sBills) + 1, Length(sBills));
+
+    rdBillsConfig.BCode := sChain;    
+
+    sChain := Copy(sBills, 1, Pos(',', sBills) - 1);
+    sBills := Copy(sBills, Pos(',', sBills) + 1, Length(sBills));
+
+    rdBillsConfig.Name := sChain;
+
+    sChain := Copy(sBills, 1, Pos(',', sBills) - 1);
+    sBills := Copy(sBills, Pos(',', sBills) + 1, Length(sBills));
+
+    rdBillsConfig.Units := sChain;
+
+    sChain := Copy(sBills, 1, Pos(',', sBills) - 1);
+    sBills := Copy(sBills, Pos(',', sBills) + 1, Length(sBills));
+
+    rdBillsConfig.IsPreDefine := UpperCase(sChain) = 'TRUE';
+
+    rdBillsConfig.Exprs := Trim(sBills);
+
+    rdBillsConfig.ParentModified := False;
+    rdBillsConfig.NextModified := False;
+
+    FRecordList.Add(rdBillsConfig);
+  end;
+end;
+
+{ TBillsDecorator }
+
+procedure TBillsDecorator.AppendBills;
+var
+  I: Integer;
+  rdBillsConfig: PBillsConfigRecord;
+begin
+  for I := 0 to FBillsConfig.FRecordList.Count - 1 do
+  begin
+    rdBillsConfig := FBillsConfig.FRecordList.List^[I];
+
+    if rdBillsConfig.ID = 0 then Continue;
+
+    FBillsCds.Append;
+    FBillsCds.FieldByName(SID).AsInteger            := rdBillsConfig.ID;
+    FBillsCds.FieldByName(sParentID).AsInteger      := rdBillsConfig.ParentID;
+    FBillsCds.FieldByName(sNextSiblingID).AsInteger := rdBillsConfig.NextID;
+    FBillsCds.FieldByName(sCode).AsString           := rdBillsConfig.Code;
+    FBillsCds.FieldByName(sB_Code).AsString         := rdBillsConfig.BCode;
+    FBillsCds.FieldByName(sName).AsString           := rdBillsConfig.Name;
+    FBillsCds.FieldByName(sUnits).AsString          := rdBillsConfig.Units;
+    FBillsCds.FieldByName(sIsPreDefine).AsBoolean   := rdBillsConfig.IsPreDefine;
+    FBillsCds.FieldByName('IsCreatePriceAnalysis').AsBoolean := True;
+    FBillsCds.Post;
+  end;
+end;
+
+function TBillsDecorator.CanDecorate: Boolean;
+begin
+  FBillsCds.EditKey;
+  FBillsCds.FieldByName(SID).AsInteger := 3;
+  Result := not FBillsCds.GotoKey;
+end;
+
+constructor TBillsDecorator.Create(const aArFileName, aCfgFileName: string);
+begin
+  FArchiver        := TScProjectFileArchiver.Create;
+  FBillsTable      := TADOTable.Create(nil);
+  FBillsDsp        := TDataSetProvider.Create(nil);
+  FBillsCds        := TClientDataSet.Create(nil);
+  FDrawQtyTable    := TADOTable.Create(nil);
+  FDrawQtyDsp      := TDataSetProvider.Create(nil);
+  FDrawQtyCds      := TClientDataSet.Create(nil);
+  FProjProperty    := TADOTable.Create(nil);
+  FProjPropertyDsp := TDataSetProvider.Create(nil);
+  FProjPropertyCds := TClientDataSet.Create(nil);
+
+  FBillsDsp.UpdateMode := upWhereKeyOnly;
+  FDrawQtyDsp.UpdateMode := upWhereKeyOnly;
+  FProjPropertyDsp.UpdateMode := upWhereKeyOnly;
+
+  FArchiver.FileName := aArFileName;
+  if FArchiver.OpenFile then
+  begin
+    FBillsTable.Connection := FArchiver.Connection;
+    FBillsTable.TableName := 'Bills';
+    FBillsDsp.DataSet := FBillsTable;
+    FBillsCds.SetProvider(FBillsDsp);
+    FBillsCds.Active := True;
+    FBillsCds.IndexFieldNames := SID;
+
+    FDrawQtyTable.Connection := FArchiver.Connection;
+    FDrawQtyTable.TableName := 'Exprs';
+    FDrawQtyDsp.DataSet := FDrawQtyTable;
+    FDrawQtyCds.SetProvider(FDrawQtyDsp);
+    FDrawQtyCds.IndexFieldNames := 'RecdID';
+    FDrawQtyCds.Active := True;
+
+    FProjProperty.Connection := FArchiver.Connection;
+    FProjProperty.TableName := 'ProjProperty';
+    FProjPropertyDsp.DataSet := FProjProperty;
+    FProjPropertyCds.SetProvider(FProjPropertyDsp);
+    FProjPropertyCds.Open;
+    FProjPropertyCds.IndexFieldNames := 'ID';
+  end;
+
+  inherited Create(aCfgFileName);
+end;
+
+procedure TBillsDecorator.Decorate;
+
+begin
+  if FDrawQtyCds.Active then
+    { TODO : Ð޸Ĺ«Ê½ }
+    ModifyExprs;
+
+  // Ð޸ļÆËãģʽ
+  if FProjPropertyCds.Active then
+    ModifyProjProperty;
+
+  if FBillsCds.Active then
+  begin
+    ModifyIsCreatePriceAnalysis;
+    FBillsCds.ApplyUpdates(0);
+  end;
+
+  if FBillsCds.Active and CanDecorate then
+  begin
+    { TODO : Read txt }
+    FBillsConfig.ResolveStrings;
+    { TODO : Modify NextID }
+    ModifyNextID;
+    ModifyItemIDs;
+    { TODO : Append Bills }
+    AppendBills;
+    { TODO : Save }
+    FBillsCds.ApplyUpdates(0);
+  end;
+  FArchiver.Save;
+end;
+
+destructor TBillsDecorator.Destroy;
+begin
+  FArchiver.Free;
+  FBillsTable.Free;
+  FBillsDsp.Free;
+  FBillsCds.Free;
+
+  FDrawQtyTable.Free;
+  FDrawQtyDsp.Free;
+  FDrawQtyCds.Free;
+  FProjProperty.Free;
+  FProjPropertyDsp.Free;
+  FProjPropertyCds.Free;
+  
+  inherited;
+end;
+
+function TBillsDecorator.MaxBillsID: Integer;
+begin
+  FBillsCds.Last;
+  Result := FBillsCds.FieldByName(SID).AsInteger;
+end;
+
+function TBillsDecorator.GetMaxProjPropertyID: Integer;
+begin
+  FProjPropertyCds.Last;
+  Result := FProjPropertyCds.FieldByName('ID').AsInteger + 1;
+end;
+
+procedure TBillsDecorator.ModifyExprs;
+begin
+  FDrawQtyCds.First;
+  while not FDrawQtyCds.Eof do
+  begin
+    if FDrawQtyCds.FieldByName('MajorID').AsInteger = 2 then
+    begin
+      FDrawQtyCds.Edit;
+      FDrawQtyCds.FieldByName('MajorID').AsInteger := 4;
+      FDrawQtyCds.FieldByName('MinorID').AsInteger := 1;
+      FDrawQtyCds.Post;
+    end;
+    FDrawQtyCds.Next;
+  end;
+  FDrawQtyCds.ApplyUpdates(0);
+end;
+
+procedure TBillsDecorator.ModifyItemIDs;
+var
+  I: Integer;
+  J: Integer;
+  iMaxID: Integer;
+  rdBillsConfig: PBillsConfigRecord;
+  rdTemConfig: PBillsConfigRecord;
+begin
+  iMaxID := MaxBillsID + 1;
+  for I := 0 to FBillsConfig.FRecordList.Count - 1 do
+  begin
+    rdBillsConfig := FBillsConfig.FRecordList.List^[I];
+
+    if rdBillsConfig.ID >= 100 then
+    begin
+      for J := 0 to FBillsConfig.FRecordList.Count - 1 do
+      begin
+        rdTemConfig := FBillsConfig.FRecordList.List^[J];
+        if rdTemConfig <> rdBillsConfig then
+        begin
+          if (not rdTemConfig.ParentModified) and (rdTemConfig.ParentID = rdBillsConfig.ID) then
+          begin
+            rdTemConfig.ParentID := iMaxID;
+            rdTemConfig.ParentModified := True;
+          end
+          else if (not rdTemConfig.NextModified) and (rdTemConfig.NextID = rdBillsConfig.ID) then
+          begin
+            rdTemConfig.NextID := iMaxID;
+            rdTemConfig.NextModified := True;
+          end;
+        end;
+      end;
+
+      rdBillsConfig.ID := iMaxID;
+      Inc(iMaxID);
+    end;
+  end;
+end;
+
+procedure TBillsDecorator.ModifyNextID;
+begin
+  FBillsCds.EditKey;
+  FBillsCds.FieldByName(SID).AsInteger := 2;
+  if FBillsCds.GotoKey then
+  begin
+    FBillsCds.Edit;
+    FBillsCds.FieldByName(sNextSiblingID).AsInteger := 3;
+    FBillsCds.Post;
+  end;
+end;
+
+procedure TBillsDecorator.ModifyProjProperty;
+var
+  iMaxID: Integer;
+begin
+  if FProjPropertyCds.Locate('Name', 'ExpressMode', []) then
+  begin
+    FProjPropertyCds.Edit;
+    FProjPropertyCds.FieldByName('ItemValue').Value := '1';
+    FProjPropertyCds.Post;
+  end
+  else
+  begin
+    iMaxID := GetMaxProjPropertyID; 
+    FProjPropertyCds.Append;
+    FProjPropertyCds.FieldByName('ID').Value := iMaxID;
+    FProjPropertyCds.FieldByName('Name').Value := 'ExpressMode';
+    FProjPropertyCds.FieldByName('ItemValue').Value := '1';
+    FProjPropertyCds.Post;
+  end;
+  FProjPropertyCds.ApplyUpdates(0);
+end;
+
+procedure TBillsDecorator.ModifyIsCreatePriceAnalysis;
+begin
+  FBillsCds.First;
+  while not FBillsCds.Eof do
+  begin
+    if not FBillsCds.FieldByName('IsCreatePriceAnalysis').AsBoolean then
+    begin
+      FBillsCds.Edit;
+      FBillsCds.FieldByName('IsCreatePriceAnalysis').AsBoolean := True;
+      FBillsCds.Post;
+    end;
+    FBillsCds.Next;
+  end;
+end;
+
+{ TDecorator }
+
+constructor TDecorator.Create(const aCfgFileName: string);
+begin
+  FBillsConfig := TBillsConfig.Create(aCfgFileName);
+end;
+
+destructor TDecorator.Destroy;
+begin
+  FBillsConfig.Free;
+  inherited;
+end;
+
+{ TCreateDecorator }
+
+procedure TCreateDecorator.ClearExprs;
+begin
+  with FBillsData.DMExprs do
+  begin
+    cdsOrgExprs.First;
+    while not cdsOrgExprs.Eof do
+      cdsOrgExprs.Delete;
+  end;
+end;
+
+constructor TCreateDecorator.Create(aBillsData: TDMDataBase;
+  const aCfgFileName: string);
+begin
+  FBillsData := aBillsData;
+  inherited Create(aCfgFileName);
+end;
+
+procedure TCreateDecorator.Decorate;
+
+begin
+  { Read Txt }
+  FBillsConfig.ResolveStrings;
+  ClearExprs;
+  { write Bills }
+  WriteBillsAndExprs;
+  Save;
+end;
+
+procedure TCreateDecorator.Save;
+begin
+  FBillsData.cdsBills.ApplyUpdates(0);
+  FBillsData.DMExprs.Save;
+end;
+
+procedure TCreateDecorator.WriteBillsAndExprs;
+
+  procedure WriteBills(ABills: PBillsConfigRecord);
+  begin
+    with FBillsData do
+    begin
+      cdsBills.Append;
+      cdsBillsID.Value := ABills.ID;
+      cdsBillsParentID.Value := ABills.ParentID;
+      cdsBillsNextSiblingID.Value := ABills.NextID;
+      cdsBillsCode.Value := ABills.Code;
+      cdsBillsB_Code.Value := ABills.BCode;
+      cdsBillsName.Value := ABills.Name;
+      cdsBillsUnits.Value := ABills.Units;
+      cdsBillsIsPreDefine.Value := ABills.IsPreDefine;
+      cdsBills.Post;
+    end;
+  end;
+
+  procedure WriteExprs(ABills: PBillsConfigRecord);
+  begin
+    if ABills.Exprs <> '' then
+      FBillsData.DMExprs.AddExprs(1, 3, ABills.ID, ABills.Exprs, 0, 0);
+  end;
+
+var
+  I: Integer;
+  rdBillsConfig: PBillsConfigRecord;
+begin
+  for I := 0 to FBillsConfig.FRecordList.Count - 1 do
+  begin
+    rdBillsConfig := FBillsConfig.FRecordList.List^[I];
+    if rdBillsConfig.ID > 0 then
+    begin
+      WriteBills(rdBillsConfig);
+      WriteExprs(rdBillsConfig);
+    end;
+  end;
+end;
+
+end.

Разница между файлами не показана из-за своего большого размера
+ 1415 - 0
CU/ExportExcel.pas


+ 377 - 0
CU/FXQDManagerUnit.pas

@@ -0,0 +1,377 @@
+unit FXQDManagerUnit;
+
+interface
+
+uses
+  Classes,
+  Windows,
+  ScProjectManager,
+  ConstVarUnit,
+  FileOprUnit,
+  ADODB,
+  Provider,
+  DBClient,
+  CommonIntfUnit;
+
+type
+  TConfigFileManager = class(TInterfacedObject, IFileManager)
+  private
+    FFileList   : TStrings;
+    { TODO : FFileFlag = 1: 表示分项清单, 2: 表示工程量清单 }
+    FFileFlag   : Integer;
+    FFileDir    : string;
+
+    procedure LoadFromFile(const aFileName: string);
+    procedure SaveToFile(const aFileName: string);
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    procedure AddFile(const aFileName: string);
+    procedure DeleteFile(const aFileName: string);
+    procedure RenameFile(const aOldFileName, aNewFileName: string);
+
+    procedure AddLibsTo(aLibs, aLibFiles: TStrings; aFileFlag: Integer);
+
+    property Libs: TStrings read FFileList;
+  end;
+
+  TFXQDManager = class(TInterfacedObject, IFileManager)
+  private
+    FFileDir           : string;
+    FFileOpr           : TFileOpr;
+    FConfigFileManager : TConfigFileManager;
+    FProjectManager    : TProjectManager;
+    FConnection        : TADOConnection;
+    FBillsTable        : TADOTable;
+    FDrawTable         : TADOTable;
+
+    function GenerateTemplateName: string;
+    { TODO : aLibName is a ShortFileName }
+    function CreateNewLib(const aLibName: string): string;
+    { TODO : aLibName is a FullFileName }
+    procedure OpenLib(const aLibName: string);
+    procedure WriteBills;
+    procedure WriteDrawingQty;
+    procedure Write;
+    procedure Save;
+    procedure Close;
+
+    procedure LoadFromFile(const aFileName: string);
+    procedure SaveToFile(const aFileName: string);
+
+    function GetFileFlag: Integer;
+    procedure SetFileFlag(const Value: Integer);
+  public
+    constructor Create(aProjectManager: TProjectManager);
+    destructor Destroy; override;
+
+    function CheckLibExists(const aShortName: string): Boolean;
+    function GenerateLibName(const aShortName: string): string;
+
+    { the Params are all shortNames }
+    procedure AddFile(const aLibName: string);
+    procedure DeleteFile(const aLibName: string);
+    procedure RenameFile(const aOldLibName, aNewLibName: string);
+    procedure ImportLib(const aOldLibName, aNewLibName: string);
+    procedure ExportLib(const aOldLibName, aNewLibName: string);
+
+    property FileFlag: Integer read GetFileFlag write SetFileFlag;
+    property ConfigFileManager: TConfigFileManager read FConfigFileManager;
+  end;
+
+implementation
+
+uses SysUtils, DataBase, DB;
+
+{ TFXQDManager }
+
+procedure TConfigFileManager.AddFile(const aFileName: string);
+begin
+  FFileList.Add(Format('%d.%s', [FFileFlag, aFileName]));
+end;
+
+procedure TConfigFileManager.AddLibsTo(aLibs, aLibFiles: TStrings;
+  aFileFlag: Integer);
+var
+  I: Integer;
+  sLib: string;
+  sHead: string;
+begin
+  sHead := IntToStr(FFileFlag) + '.';
+
+  for I := 0 to FFileList.Count - 1 do
+  begin
+    sLib := FFileList[I];
+    if Pos(sHead, sLib) = 1 then
+    begin
+      sLib := Copy(sLib, Pos('.', sLib) + 1, Length(sLib));
+      aLibs.Add(sLib);
+      sLib := Format('%sStdLibs\%s.dat', [FFileDir, sLib]);
+      aLibFiles.Add(sLib);
+    end;
+  end;
+end;
+
+constructor TConfigFileManager.Create;
+begin
+  FFileFlag := 1;
+  FFileList := TStringList.Create;
+end;
+
+procedure TConfigFileManager.DeleteFile(const aFileName: string);
+var
+  iIdx: Integer;
+begin
+  iIdx := FFileList.IndexOf(Format('%d.%s', [FFileFlag, aFileName]));
+  if iIdx > -1 then
+    FFileList.Delete(iIdx);
+end;
+
+destructor TConfigFileManager.Destroy;
+begin
+  FFileList.Free;
+  inherited;
+end;
+
+procedure TConfigFileManager.LoadFromFile(const aFileName: string);
+begin
+  if FileExists(aFileName) then
+    FFileList.LoadFromFile(aFileName)
+  else
+    FFileList.Clear;
+end;
+
+procedure TConfigFileManager.RenameFile(const aOldFileName, aNewFileName: string);
+var
+  iIdx: Integer;
+begin
+  iIdx := FFileList.IndexOf(Format('%d.%s', [FFileFlag, aOldFileName]));
+  if iIdx > -1 then
+    FFileList[iIdx] := Format('%d.%s', [FFileFlag, aNewFileName]);
+end;
+
+procedure TConfigFileManager.SaveToFile(const aFileName: string);
+begin
+  FFileList.SaveToFile(aFileName);
+end;
+
+procedure TFXQDManager.WriteBills;
+begin
+  with FProjectManager.ActiveProject.BillsData do
+  begin
+    cdsBills.First;
+    while not cdsBills.Eof do
+    begin
+      { Value 和 AsString 产生的结果不一样!!! }
+      { 为安全起见,最好还是用 AsString 吧 }
+//      slist.Add(cdsBillsCode.Value + ' <---->  ' + cdsBillsB_Code.Value);
+ //     slist.Add(cdsBillsCode.AsString + ' <---->  ' + cdsBillsB_Code.AsString);
+
+      FBillsTable.Append;
+      FBillsTable.FieldByName(SID).AsInteger := cdsBillsID.AsInteger;
+      FBillsTable.FieldByName(sParentID).AsInteger := cdsBillsParentID.AsInteger;
+      FBillsTable.FieldByName('NextID').AsInteger := cdsBillsNextSiblingID.AsInteger;
+      FBillsTable.FieldByName(sCode).AsString := cdsBillsCode.AsString;
+      FBillsTable.FieldByName(sB_Code).AsString := cdsBillsB_Code.AsString;
+      FBillsTable.FieldByName(sName).AsString := cdsBillsName.AsString;
+      FBillsTable.FieldByName('Unit').AsString := cdsBillsUnits.AsString;
+      if cdsBillsID.Value < 100 then
+        FBillsTable.FieldByName('StaticID').AsInteger := cdsBillsID.AsInteger;
+      FBillsTable.FieldByName(sMemoStr).AsString := cdsBillsMemoStr.AsString;
+      FBillsTable.Post; 
+
+      cdsBills.Next;
+    end;
+  end;
+end;
+
+procedure TFXQDManager.WriteDrawingQty;
+begin
+  with FProjectManager.ActiveProject.BillsData do
+  begin
+    cdsDrawingQuantity.First;
+    while not cdsDrawingQuantity.Eof do
+    begin
+      FDrawTable.Append;
+      FDrawTable.FieldByName(SID).AsInteger := cdsDrawingQuantityID.AsInteger;
+      FDrawTable.FieldByName(sName).AsString := cdsDrawingQuantityName.AsString;
+      FDrawTable.FieldByName(sUnits).AsString := cdsDrawingQuantityUnits.AsString;
+      FDrawTable.FieldByName(sDesignQuantity).AsFloat := cdsDrawingQuantityDQuantity1.AsFloat;
+      FDrawTable.FieldByName(sDesignQuantity2).AsFloat := cdsDrawingQuantityDQuantity2.AsFloat;
+      FDrawTable.FieldByName(sMemoStr).AsString := cdsDrawingQuantityMemoContext.AsString;
+      FDrawTable.FieldByName(sBillsID).AsInteger := cdsDrawingQuantityBillsID.AsInteger;
+      FDrawTable.Post;
+
+      cdsDrawingQuantity.Next;
+
+    end;
+  end;
+end;
+
+{ TFXQDManager }
+
+procedure TFXQDManager.AddFile(const aLibName: string);
+var
+  sNewFileName: string;
+begin
+  sNewFileName := CreateNewLib(aLibName);
+  if sNewFileName = '' then Exit;
+
+  FConfigFileManager.AddFile(aLibName);
+  
+  OpenLib(sNewFileName);
+  Write;
+  Save;
+  Close;
+end;
+
+function TFXQDManager.CheckLibExists(const aShortName: string): Boolean;
+var
+  sLibName: string;
+begin
+  sLibName := GenerateLibName(aShortName);
+  Result := FFileOpr.FileExists(sLibName);
+end;
+
+procedure TFXQDManager.Close;
+begin
+  FConnection.Close;
+end;
+
+constructor TFXQDManager.Create(aProjectManager: TProjectManager);
+begin
+  FFileOpr := TFileOpr.Create;
+  FFileDir := FFileOpr.ExtractFilePath(ParamStr(0));
+  FProjectManager := aProjectManager;
+
+  FConnection := TADOConnection.Create(nil);
+  FConnection.LoginPrompt := False;
+  FBillsTable := TADOTable.Create(nil);
+  FDrawTable := TADOTable.Create(nil);
+
+  FConfigFileManager := TConfigFileManager.Create;
+  FConfigFileManager.FFileDir := FFileDir;
+  LoadFromFile({$I StdLibs.inc});
+end;
+
+function TFXQDManager.CreateNewLib(const aLibName: string): string;
+var
+  sTemplateName: string;
+begin
+  Result := GenerateLibName(aLibName);
+  sTemplateName := GenerateTemplateName;
+  if not FFileOpr.CopyFile(sTemplateName, Result) then
+    Result := '';
+end;
+
+procedure TFXQDManager.DeleteFile(const aLibName: string);
+var
+  sLibName: string;
+begin
+  sLibName := GenerateLibName(aLibName);
+  FFileOpr.DeleteFile(sLibName);
+  FConfigFileManager.DeleteFile(aLibName);
+  Save;
+end;
+
+destructor TFXQDManager.Destroy;
+begin
+  FConnection.Free;
+  FBillsTable.Free;
+  FDrawTable.Free;
+  FFileOpr.Free;
+  FConfigFileManager.Free;
+  inherited;
+end;
+
+procedure TFXQDManager.ExportLib(const aOldLibName, aNewLibName: string);
+begin
+  FFileOpr.CopyFile(aOldLibName, aNewLibName);
+  Save;
+end;
+
+function TFXQDManager.GenerateLibName(const aShortName: string): string;
+begin
+  Result := Format('%sStdLibs\%s.dat', [FFileDir, aShortName]);
+end;
+
+function TFXQDManager.GenerateTemplateName: string;
+begin
+  if FileFlag = 1 then
+    Result := Format('%sData\%s', [FFileDir, FXTemplateFile])
+  else
+    Result := '';
+end;
+
+function TFXQDManager.GetFileFlag: Integer;
+begin
+  Result := FConfigFileManager.FFileFlag;
+end;
+
+procedure TFXQDManager.ImportLib(const aOldLibName, aNewLibName: string);
+var
+  sNewLibName: string;
+begin
+  sNewLibName := GenerateLibName(aNewLibName);
+  FFileOpr.CopyFile(aOldLibName, sNewLibName);
+  FConfigFileManager.AddFile(aNewLibName);
+  Save;
+end;
+
+procedure TFXQDManager.LoadFromFile(const aFileName: string);
+begin
+  FConfigFileManager.LoadFromFile(aFileName);
+end;
+
+procedure TFXQDManager.OpenLib(const aLibName: string);
+begin
+  FConnection.ConnectionString := Format(SAdoConnectStr, [aLibName, 'Admin', '']);
+  FConnection.Open;
+
+  FBillsTable.Connection := FConnection;
+  FDrawTable.Connection := FConnection;
+
+  FBillsTable.TableName := 'BillsTree';
+  FDrawTable.TableName := 'DrawingQuantity';
+
+  FBillsTable.Active := True;
+  if FileFlag = 1 then
+    FDrawTable.Active := True;
+end;
+
+procedure TFXQDManager.RenameFile(const aOldLibName, aNewLibName: string);
+var
+  sOldLibName: string;
+  sNewLibName: string;
+begin
+  sOldLibName := GenerateLibName(aOldLibName);
+  sNewLibName := GenerateLibName(aNewLibName);
+  FFileOpr.RenameFile(sOldLibName, sNewLibName);
+  FConfigFileManager.RenameFile(aOldLibName, aNewLibName);
+  Save;
+end;
+
+procedure TFXQDManager.Save;
+begin
+  SaveToFile({$I StdLibs.inc});
+end;
+
+procedure TFXQDManager.SaveToFile(const aFileName: string);
+begin
+  FConfigFileManager.SaveToFile(aFileName);
+end;
+
+procedure TFXQDManager.SetFileFlag(const Value: Integer);
+begin
+  FConfigFileManager.FFileFlag := Value;
+end;
+
+procedure TFXQDManager.Write;
+begin
+  WriteBills;
+  if FileFlag = 1 then
+    WriteDrawingQty;
+end;
+
+end.

+ 70 - 0
CU/FileOprUnit.pas

@@ -0,0 +1,70 @@
+
+{
+   **************************************
+
+   描述: 本单元主要用一个类来管理对文件
+          的操作,而不是直接用API等方法。
+
+   **************************************
+}
+
+unit FileOprUnit;
+
+interface
+
+uses
+  Windows,
+  SysUtils;
+
+type
+  TFileOpr = class
+  public
+    procedure DeleteFile(const aFileName: string);
+    function CopyFile(const aSrcPath, aDestPath: string): Boolean;
+    function FileExists(const aFileName: string): Boolean;
+    function DirectoryExists(const aDir: string): Boolean;
+    procedure CreateDirectory(const aDir: string);
+    function ExtractFilePath(const aFilePath: string): string;
+    procedure RenameFile(const aOldFileName, aNewFileName: string);
+  end;
+
+implementation
+
+{ TFileOpr }
+
+function TFileOpr.CopyFile(const aSrcPath, aDestPath: string): Boolean;
+begin
+  Result := Windows.CopyFile(PChar(aSrcPath), PChar(aDestPath), True);
+end;
+
+procedure TFileOpr.CreateDirectory(const aDir: string);
+begin
+  SysUtils.ForceDirectories(aDir);
+end;
+
+procedure TFileOpr.DeleteFile(const aFileName: string);
+begin
+  Windows.DeleteFile(PChar(aFileName));
+end;
+
+function TFileOpr.DirectoryExists(const aDir: string): Boolean;
+begin
+  Result := SysUtils.DirectoryExists(aDir);
+end;
+
+function TFileOpr.ExtractFilePath(const aFilePath: string): string;
+begin
+  Result := SysUtils.ExtractFilePath(aFilePath);
+end;
+
+function TFileOpr.FileExists(const aFileName: string): Boolean;
+begin
+  Result := SysUtils.FileExists(aFileName);
+end;
+
+procedure TFileOpr.RenameFile(const aOldFileName, aNewFileName: string);
+begin
+  SysUtils.RenameFile(aOldFileName,aNewFileName);
+end;
+
+end.

+ 94 - 0
CU/ImportDecorate.pas

@@ -0,0 +1,94 @@
+unit ImportDecorate;
+
+interface
+
+uses
+  Classes, ADODB, DataBase, ConstTypeUnit, Provider,
+  ConstMethodUnit, DBClient, DB, ConstVarUnit, ScFileArchiver;
+
+type
+  TImportDecorator = class
+  private
+    FProjectArchiver: TScProjectFileArchiver;
+    FAtExprs: TADOTable;
+    FDspExprs: TDataSetProvider;
+    FCdsExprs: TClientDataSet;
+
+    procedure DecorateExprs;
+    procedure ConnectExprs;
+    procedure Save;
+  public
+    constructor Create(const AProjectFile: string);
+    destructor Destroy; override;
+
+    procedure Decorate;
+  end;
+
+implementation
+
+{ TImportDecorator }
+
+procedure TImportDecorator.ConnectExprs;
+begin
+  FAtExprs.Connection := FProjectArchiver.Connection;
+  FAtExprs.TableName := 'Exprs';
+  FDspExprs.DataSet := FAtExprs;
+  FCdsExprs.SetProvider(FDspExprs);
+  FCdsExprs.IndexFieldNames := 'RecdID';
+  FCdsExprs.Active := True;
+end;
+
+constructor TImportDecorator.Create(const AProjectFile: string);
+begin
+  FProjectArchiver := TScProjectFileArchiver.Create;
+  FAtExprs := TADOTable.Create(nil);
+  FDspExprs := TDataSetProvider.Create(nil);
+  FDspExprs.UpdateMode := upWhereKeyOnly;
+  FCdsExprs := TClientDataSet.Create(nil);
+
+  FProjectArchiver.FileName := AProjectFile;
+  if FProjectArchiver.OpenFile then
+    ConnectExprs;
+end;
+
+procedure TImportDecorator.Decorate;
+begin
+  if FCdsExprs.Active then
+  begin
+    DecorateExprs;
+    Save;
+  end;
+end;
+
+procedure TImportDecorator.DecorateExprs;
+begin
+  FCdsExprs.First;
+  while not FCdsExprs.Eof do
+  begin
+    if FCdsExprs.FieldByName('MajorID').AsInteger = 4 then
+    begin
+      FCdsExprs.Edit;
+      FCdsExprs.FieldByName('MajorID').AsInteger := Exprs_DrawQty_ID;
+      FCdsExprs.FieldByName('MinorID').AsInteger := Exprs_DQty_ID;
+      FCdsExprs.Post;
+    end;
+    FCdsExprs.Next;
+  end;
+end;
+
+destructor TImportDecorator.Destroy;
+begin
+  FProjectArchiver.Free;
+  FAtExprs.Free;
+  FDspExprs.Free;
+  FCdsExprs.Free;
+  inherited;
+end;
+
+procedure TImportDecorator.Save;
+begin
+  FCdsExprs.ApplyUpdates(0);
+  FProjectArchiver.Save;
+end;
+
+end.

+ 871 - 0
CU/ImportExcel.pas

@@ -0,0 +1,871 @@
+unit ImportExcel;
+
+interface
+
+uses
+  DataBase,
+  SMCells,
+  SMXLS,
+  Classes,
+  ScKindsOfTrees,
+  Variants;
+
+type
+  TExcelImportor = class
+  private
+    FMSExcel  : TMSExcel;
+    FBillsData: TDMDataBase;
+    FExcelTree: TScExcelItemTree;
+    FCaptions : TStrings;
+    FSpecialItems: TStrings;  // 图标排除项
+
+    procedure InitSpecialItems(ASpecialItems: TStrings);
+    function IsSpecialItem(const AString: string): Boolean;
+    procedure ExtractSheetCaption;
+    function SelectExcelSheet: Boolean;
+    { 导入Sheets }
+    procedure ImportSheets;
+    function GetStartRow(aSheet: TSpreadSheet): Integer;
+    function GetEndRow(aSheet: TSpreadSheet): Integer;
+    procedure ImportSheet(aSheet: TSpreadSheet);
+    // 结算格式
+    function IsBalanceFormat(ASheet: TSpreadSheet): Boolean;
+    // 判断是否是招预01-1格式的Excel
+    function Is01_1Excel(ASheet: TSpreadSheet): Boolean; // Add By GiLi
+    procedure ImportBalanceSheet(ASheet: TSpreadSheet);
+    procedure Import01_1Excel(ASheet: TSpreadSheet);     // Add By GiLi
+    { 初始化数据 }
+    procedure InitExcelTree;
+    { 提交数据到DB }
+    procedure CommitData;
+  public
+    constructor Create(aBillsData: TDMDataBase; const aXlsFileName: string);
+    destructor Destroy; override;
+
+    { 导入清单文件 }
+    procedure ImportExcel;
+    { 导入工程量清单单价 }
+    procedure ImportQtyItems;
+  end;
+
+implementation
+
+uses
+  ExportExFrm,
+  ConstMethodUnit,
+  SysUtils,
+  ScProgressFrm,
+  StrUtils;
+
+// 删除字符串中所以指定的字符
+function DeleteCharFormString(var AString: string; const AChar: Char): string;
+var
+  iPos: Integer;
+  sStr: string;
+begin
+  sStr := AString;
+  iPos := Pos(AChar, sStr);
+  while iPos <> 0 do
+  begin
+    Delete(sStr, iPos, 1);
+    iPos := Pos(AChar, sStr);
+  end;
+  AString := sStr;
+  Result := sStr;
+end;
+{去掉换行符}
+procedure DeleteRowBack(var str: string);
+var
+  I: Integer;
+begin
+  for I := Length(str) downto 1 do
+  begin
+    if (str[I] = #10) or (str[I] = #13) then
+      Delete(str, I, 1);
+  end;
+end;  
+
+{ TExcelImportor }
+
+procedure TExcelImportor.CommitData;
+begin
+  FExcelTree.RefreshDataBase;
+end;
+
+constructor TExcelImportor.Create(aBillsData: TDMDataBase;
+  const aXlsFileName: string);
+begin
+  FBillsData := aBillsData;
+  FMSExcel := TMSExcel.Create(nil);
+  FMSExcel.LoadFromFile(aXlsFileName);
+  FExcelTree := TScExcelItemTree.Create(FBillsData);
+  FCaptions := TStringList.Create;
+  FSpecialItems := TStringList.Create;
+  InitSpecialItems(FSpecialItems);
+end;
+
+destructor TExcelImportor.Destroy;
+begin
+  FMSExcel.Free;
+  FExcelTree.Free;
+  FCaptions.Free;
+  inherited;
+end;
+
+procedure TExcelImportor.ExtractSheetCaption;
+var
+  I: Integer;
+  sCaption: string;
+begin
+  for I := 0 to FMSExcel.Sheets.Count - 1 do
+  begin
+    sCaption := FMSExcel.Sheets.Spreadsheet(I).Caption;
+    FCaptions.AddObject(sCaption, Pointer(I));
+  end;
+end;
+
+function TExcelImportor.GetEndRow(aSheet: TSpreadSheet): Integer;
+begin
+  Result := aSheet.Cells.UsedRowCount - 1;
+  if Pos('备注', VarToStr(aSheet.Cells.GetValue(0, Result))) <> 0 then
+    Result := Result - 1;
+end;
+
+function TExcelImportor.GetStartRow(aSheet: TSpreadSheet): Integer;
+var
+  I: Integer;
+begin
+  Result := -1; 
+  for I := 0 to aSheet.Cells.UsedRowCount - 1 do
+  begin
+    if (Pos('-', VarToStr(aSheet.Cells.GetValue(0, I))) <> 0)
+       and
+       (Pos('附件', VarToStr(aSheet.Cells.GetValue(0, I))) = 0)
+    then
+    begin
+      Result := I;
+      Break;
+    end;
+
+    if SameText(VarToStr(aSheet.Cells.GetValue(0, I)), '预算项目节')
+       or
+       SameText(VarToStr(aSheet.Cells.GetValue(0, I)), '项目节编号')
+    then
+    begin
+      Result := I + 1;
+      Break;
+    end;
+  end;
+end;
+
+procedure TExcelImportor.Import01_1Excel(ASheet: TSpreadSheet);
+var
+  iRow, I: Integer;
+  iSerialNo: Integer;
+  strXMJCode: string;
+  strBillsCode: string;
+  strName: string;
+  sgsCodes: TStrings;
+  bCodeEmpty: Boolean;
+  PartCode: string;
+
+  function SetCurPartCode: string;
+  var
+    ACurName: string;
+  begin
+    ACurName := Trim(VarToStrDef(aSheet.Cells.GetValue(5, iRow), ''));
+    DeleteRowBack(ACurName);
+    DeleteCharFormString(ACurName, #32);
+    if Pos('第一部分', ACurName) > 0 then
+      PartCode := '1-'
+    else
+    if Pos('第二部分', ACurName) > 0 then
+      PartCode := '2-'
+    else
+    if Pos('第三部分', ACurName) > 0 then
+      PartCode := '3-'
+    else
+    if Pos('第一、二、三部分', ACurName) > 0 then
+      PartCode := ''
+    else
+      PartCode := PartCode;
+  end;
+
+  function GetXMJCode: string;
+  const
+    c_widestring: WideString = '一二三四五六七八九十';
+  var
+    ACurCode: string;
+    ACurBuFenName: string;
+  var
+    I: Integer;
+  begin
+    Result := '';
+    for I := 0 to sgsCodes.Count - 1 do
+    begin
+      ACurCode := sgsCodes[I];
+      // 如果是汉字的数字 一二...
+      if Length(ACurCode) > 1 then
+      begin
+        // 有两个数字的汉字
+        if Length(ACurCode) > 2 then
+        begin
+          ACurCode := IntToStr(10 * Pos(LeftStr(ACurCode, 1), c_widestring)
+                                  + Pos(RightStr(ACurCode, 1), c_widestring));
+        end
+        // 只有一个数字的汉字
+        else
+        begin
+          ACurCode := IntToStr(Pos(ACurCode, c_widestring));
+        end;
+      end;
+      if Result = '' then
+        Result := ACurCode
+      else
+        Result := Result + '-' + ACurCode;
+    end;
+    SetCurPartCode;
+    if Result <> '' then
+      Result := PartCode + Result;
+  end;
+
+  function GetBillsCode: string;
+  begin
+    Result := Trim(VarToStrDef(aSheet.Cells.GetValue(4, iRow), ''));
+  end;
+
+  function GetName: string;
+  begin
+    Result := Trim(VarToStrDef(aSheet.Cells.GetValue(5, iRow), ''));
+    DeleteRowBack(Result);
+    SetCurPartCode;
+  end;
+
+  function IsDrawingQuantity: Boolean;
+  begin
+    Result := (strXMJCode = '') and (strBillsCode = '') and (not IsSpecialItem(Trim(strName)))
+      and (strName <> '暂列金额(不含计日工总额)') and (strName <> '保险费')
+      and (strName <> '*请在此输入费用项目');
+  end;
+
+  procedure AddDrawingQuantity;
+  var
+    DrawingItem: TDrawingQuantityItem;
+  begin
+    if strName <> '' then
+    begin
+      DrawingItem := FExcelTree.AddDrawQuantity;
+      DrawingItem.SerinalNo := iSerialNo;
+      DrawingItem.Name := strName;
+      DrawingItem.Units := VarToStrDef(ASheet.Cells.GetValue(6, iRow), '');
+      Inc(iSerialNo);
+    end;
+  end;
+
+  function GetFloatValue(ACol: Integer): Double;
+  var
+    V: Variant;
+    sValue: string;
+  begin
+    Result := 0;
+    V := ASheet.Cells.GetValue(ACol, iRow);
+
+    if not VarIsNull(V) then
+    begin
+      sValue := Trim(VarToStrDef(V, ''));
+      DeleteRowBack(sValue);
+      DeleteCharFormString(sValue, ',');
+      Result := StrToFloatDef(Trim(sValue), 0);
+    end;
+
+  end;
+
+  procedure GetQuantityXY(const vQuantity: Variant; var X,Y: Double);
+  var
+    iDivPos, iTemp: Integer; // 除号的位置
+    AStrQuantity, strTemp: string;
+  begin
+    X := 0;
+    Y := 0;
+    if VarIsNull(vQuantity) then
+      Exit;
+    AStrQuantity := VarToStrDef(vQuantity, '');
+    iDivPos := Pos('/', AStrQuantity);
+    if iDivPos = 0 then
+    begin
+      Val(AStrQuantity, X, iDivPos);
+      Y := 0;
+    end
+    else
+    begin
+      strTemp := AStrQuantity;
+      iTemp := iDivPos;
+      Val(LeftStr(AStrQuantity, iDivPos - 1), X, iDivPos);
+      strTemp := Copy(strTemp, iTemp+1, Length(strTemp));
+      Val(strTemp, Y, iDivPos);
+    end;
+  end;
+  procedure AddXMJBills;
+  var
+    xlsItem: TScExcelItem;
+    CurQuantity: Variant;
+    Quantity1, Quantity2: Double;
+  begin
+    xlsItem := FExcelTree.AddNodeByCode(strXMJCode, strBillsCode);
+    if Assigned(xlsItem) then
+    begin
+      xlsItem.Name := strName;
+      xlsItem.Units := VarToStrDef(ASheet.Cells.GetValue(6, iRow), '');
+      // 数量
+      CurQuantity := ASheet.Cells.GetValue(7, iRow);
+      GetQuantityXY(CurQuantity, Quantity1, Quantity2);
+      // 清单数量
+      //xlsItem.Quantity := GetFloatValue(x);
+      if strBillsCode <> '' then
+      begin
+        xlsItem.Quantity := Quantity1;
+        // 清单单价
+        xlsItem.Price := GetFloatValue(9);
+      end
+      else
+      // 设计数量
+      begin
+        // 设计数量1
+        if Quantity1 <> 0 then
+          xlsItem.Quantity1 := Quantity1;
+        // 设计数量2
+        if Quantity2 <> 0 then
+          xlsItem.Quantity2 := Quantity2;
+      end;
+
+      // 金额
+      xlsItem.TotalPrice := GetFloatValue(8);
+      xlsItem.MemoString := VarToStrDef(ASheet.Cells.GetValue(11, iRow), '');
+    end;
+    iSerialNo := 1;
+  end;
+
+  procedure InitXMJCodeAndBillsCodeAndName;
+  begin
+    strBillsCode := GetBillsCode;
+    if strBillsCode <> '' then
+    begin
+      DeleteRowBack(strBillsCode);
+      DeleteCharFormString(strBillsCode, #32);
+    end;
+    strName := GetName;
+    if (strBillsCode = '') and (not bCodeEmpty) then
+      strXMJCode := GetXMJCode
+    else
+      strXMJCode := '';
+  end;
+
+  procedure MapXMJCode(AColumn: Integer);
+  var
+    strCode: string;
+  begin
+    strCode := Trim(VarToStrDef(aSheet.Cells.GetValue(AColumn, iRow), ''));
+    if strCode <> '' then
+    begin
+      while sgsCodes.Count > AColumn do
+        sgsCodes.Delete(sgsCodes.Count - 1);
+      sgsCodes.Add(strCode);
+      bCodeEmpty := False;
+    end;
+  end;
+
+  procedure MapXMJCodeIntoStrings;
+  begin
+    MapXMJCode(0);
+    MapXMJCode(1);
+    MapXMJCode(2);
+    MapXMJCode(3);
+  end;
+
+  procedure ImportRowXMJBillsAndDrawingQuantity;
+  begin
+    if IsDrawingQuantity then
+      AddDrawingQuantity
+    else
+      AddXMJBills;
+  end;
+
+  procedure ResetCodeEmpty;
+  begin
+    bCodeEmpty := True;
+  end;
+
+  function GetCurRow(aI: Integer): Integer;
+  var
+    ACurName: string;
+  begin
+    ACurName := Trim(VarToStrDef(aSheet.Cells.GetValue(1 , aI), ''));
+    if Pos('编制', ACurName) > 0 then
+      Result := aI + 5
+    else
+      Result := aI;
+  end;
+
+begin
+  sgsCodes := TStringList.Create;
+  try
+    // 01-1 表从第三行开始
+    I := 4;
+    PartCode := '';
+    while I < ASheet.Cells.UsedRowCount do
+    begin
+      iRow := GetCurRow(I);
+      if iRow <> I then
+        I := iRow;
+      ResetCodeEmpty;
+      MapXMJCodeIntoStrings;
+      InitXMJCodeAndBillsCodeAndName;
+      ImportRowXMJBillsAndDrawingQuantity;
+      Inc(I);
+    end;
+  finally
+    sgsCodes.Free;
+  end;
+end;
+
+procedure TExcelImportor.ImportBalanceSheet(ASheet: TSpreadSheet);
+var
+  iRow: Integer;
+  iSerialNo: Integer;
+  strXMJCode: string;
+  strBillsCode: string;
+  strName: string;
+  sgsCodes: TStrings;
+  bCodeEmpty: Boolean;
+
+  function GetXMJCode: string;
+  var
+    I: Integer;
+  begin
+    Result := '';
+    for I := 0 to sgsCodes.Count - 1 do
+    begin
+      if Result = '' then
+        Result := sgsCodes[I]
+      else
+        Result := Result + '-' + sgsCodes[I];
+    end;
+    if Result <> '' then
+      Result := '1-' + Result;
+  end;
+
+  function GetBillsCode: string;
+  begin
+    Result := Trim(VarToStrDef(aSheet.Cells.GetValue(7, iRow), ''));
+  end;
+
+  function GetName: string;
+  begin
+    Result := Trim(VarToStrDef(aSheet.Cells.GetValue(8, iRow), ''));
+    DeleteRowBack(Result);
+  end;
+
+  function IsDrawingQuantity: Boolean;
+  begin
+    Result := (strXMJCode = '') and (strBillsCode = '');
+  end;
+
+  procedure AddDrawingQuantity;
+  var
+    DrawingItem: TDrawingQuantityItem;
+  begin
+    if strName <> '' then
+    begin
+      DrawingItem := FExcelTree.AddDrawQuantity;
+      DrawingItem.SerinalNo := iSerialNo;
+      DrawingItem.Name := strName;
+      DrawingItem.Units := VarToStrDef(ASheet.Cells.GetValue(9, iRow), '');
+      Inc(iSerialNo);
+    end;
+  end;
+
+  function GetFloatValue(ACol: Integer): Double;
+  var
+    V: Variant;
+  begin
+    Result := 0;
+    V := ASheet.Cells.GetValue(ACol, iRow);
+    if not VarIsNull(V) then
+      Result := StrToFloatDef(Trim(V), 0);
+  end;
+
+  procedure AddXMJBills;
+  var
+    xlsItem: TScExcelItem;
+  begin
+    xlsItem := FExcelTree.AddNodeByCode(strXMJCode, strBillsCode);
+    if Assigned(xlsItem) then
+    begin
+      xlsItem.Name := strName;
+      xlsItem.Units := VarToStrDef(ASheet.Cells.GetValue(9, iRow), '');
+      // 清单数量
+      xlsItem.Quantity := GetFloatValue(10);
+      // 设计数量1
+      xlsItem.Quantity1 := GetFloatValue(11);
+      // 设计数量2
+      xlsItem.Quantity2 := GetFloatValue(12);
+      // 单价
+      xlsItem.Price := GetFloatValue(13);
+      // 金额
+      xlsItem.TotalPrice := GetFloatValue(14);
+    end;
+    iSerialNo := 1;
+  end;
+
+  procedure InitXMJCodeAndBillsCodeAndName;
+  begin
+    strBillsCode := GetBillsCode;
+    strName := GetName;
+    if (strBillsCode = '') and (not bCodeEmpty) then
+      strXMJCode := GetXMJCode
+    else
+      strXMJCode := '';
+  end;
+
+  procedure MapXMJCode(AColumn: Integer);
+  var
+    strCode: string;
+  begin
+    strCode := Trim(VarToStrDef(aSheet.Cells.GetValue(AColumn, iRow), ''));
+    if strCode <> '' then
+    begin
+      while sgsCodes.Count > AColumn do
+        sgsCodes.Delete(sgsCodes.Count - 1);
+      sgsCodes.Add(strCode);
+      bCodeEmpty := False;
+    end;
+  end;
+
+  procedure MapXMJCodeIntoStrings;
+  begin
+    MapXMJCode(0);
+    MapXMJCode(1);
+    MapXMJCode(2);
+    MapXMJCode(3);
+    MapXMJCode(4);
+    MapXMJCode(5);
+    MapXMJCode(6);
+  end;
+
+  procedure ImportRowXMJBillsAndDrawingQuantity;
+  begin
+    if IsDrawingQuantity then
+      AddDrawingQuantity
+    else
+      AddXMJBills;
+  end;
+
+  procedure ResetCodeEmpty;
+  begin
+    bCodeEmpty := True;
+  end;
+
+begin
+  sgsCodes := TStringList.Create;
+  try
+    for iRow := 1 to ASheet.Cells.UsedRowCount - 1 do
+    begin
+      ResetCodeEmpty;
+      MapXMJCodeIntoStrings;
+      InitXMJCodeAndBillsCodeAndName;
+      ImportRowXMJBillsAndDrawingQuantity;
+    end;
+  finally
+    sgsCodes.Free;
+  end;
+end;
+
+procedure TExcelImportor.ImportExcel;
+begin
+  ExtractSheetCaption;
+  if not SelectExcelSheet then Exit;
+
+  AddProgressForm(10,'正在检测Excel...');
+  IncProgressUI(10);
+
+  InitExcelTree;
+  AddProgressForm(10,'正在初始化Excel...');
+  IncProgressUI(10);
+
+  ImportSheets;
+  AddProgressForm(50,'正在导入Excel...');
+  IncProgressUI(50);
+
+  CommitData;
+  AddProgressForm(20,'正在生成数据...');
+  IncProgressUI(20);
+end;
+
+procedure TExcelImportor.ImportQtyItems;
+var
+  iLoop, iRow: Integer;
+  ssSheet: TSpreadSheet;
+  strCode: string;
+  bReading: Boolean;
+  dUnitPrice: Double;
+begin
+  FBillsData.BeginImport;
+  // Added by GiLi 2012-4-18 15:11:11 添加浮动进度条
+  CreateProgressForm(100, '正在导入工程量清单单价>>>');
+  try
+    for iLoop := 0 to FMSExcel.Sheets.Count - 1 do
+    begin
+      ssSheet := FMSExcel.Sheets.Spreadsheet(iLoop);
+
+      iRow := 0;
+      bReading := False;
+      while iRow <= ssSheet.Cells.UsedRowCount - 1 do
+      begin
+        strCode := Trim(VarToStrDef(ssSheet.Cells.GetValue(0, iRow), ''));
+        if not bReading then
+        begin
+          if SameText(strCode, '子目号') then
+            bReading := True;
+          Inc(iRow);
+          Continue;
+        end;
+        if strCode = '' then
+        begin
+          bReading := False;
+          Inc(iRow);
+          Continue;
+        end;
+        if VarIsNull(ssSheet.Cells.GetValue(4, iRow)) then
+          dUnitPrice := 0
+        else
+          dUnitPrice := StrToFloatDef(Trim(ssSheet.Cells.GetValue(4, iRow)), 0);
+        AddProgressForm(10, Format('正在导入第%d个Sheet...', [iLoop + 1]));
+        FBillsData.AssignQtyItemUnitPrice(strCode, dUnitPrice);
+        Inc(iRow);
+      end;
+    end;
+  finally
+    CloseFloatProgress;
+    FBillsData.EndImport;
+  end;
+end;
+
+procedure TExcelImportor.ImportSheet(aSheet: TSpreadSheet);
+var
+  iBeginRow: Integer;
+  iEndRow  : Integer;
+  iCurRow  : Integer;
+  iSerialNo: Integer;
+
+  iCode    : Integer;
+  iErrCode : Integer;
+
+  sCode    : string;
+  sB_Code  : string;
+  sName    : string;
+
+  xlsItem  : TScExcelItem;
+  xlsDQItem: TDrawingQuantityItem;
+begin
+  iBeginRow := GetStartRow(aSheet);
+  iEndRow := GetEndRow(aSheet);
+
+  if (iBeginRow = -1) or (iBeginRow > iEndRow) then
+    raise Exception.Create(Format('读取工作表[%s]的数据失败, 请检查该表是否有数据或格式是否正确!',
+                           [aSheet.Caption]));
+
+  iSerialNo := 1;
+  for iCurRow := iBeginRow to iEndRow do
+  begin
+    sCode   := Trim(VarToStrDef(aSheet.Cells.GetValue(0, iCurRow), ''));
+    sB_Code := Trim(VarToStrDef(aSheet.Cells.GetValue(1, iCurRow), ''));
+    sName   := Trim(VarToStrDef(aSheet.Cells.GetValue(2, iCurRow), ''));
+
+
+  {新需求,只导入一二三部分。 chenshilong, 2013-08-15
+
+  [需求描述]导入三级清单后,一二三部分之后的工程量清单位置错误。
+
+  如:102-5交通管制经费跑到第二部分下了,有的跑到第一和第三部分下了。
+
+  如:第三部分之后的项目节导入为第三部分中最后一个节点的设计细目了。
+
+  解决方案为:导入时,读取到“第一、二、三部分 费用合计”这行时,则
+
+  停止导入后面的数据行。}
+
+    if SameText(sName, '第一、二、三部分 费用合计') then Break;
+
+
+    DeleteRowBack(sName);
+
+    if (sCode = '') and (sB_Code = '') then
+    begin
+      if sName = '' then Continue;
+
+      xlsDQItem := FExcelTree.AddDrawQuantity;
+
+      xlsDQItem.SerinalNo := iSerialNo;
+      xlsDQItem.Name      := sName;
+      xlsDQItem.Units     := VarToStrDef(aSheet.Cells.GetValue(3, iCurRow), '');
+
+      if not VarIsNull(aSheet.Cells.GetValue(5, iCurRow)) then
+        xlsDQItem.DesignQuantity1
+                          := StrToFloatDef(Trim(aSheet.Cells.GetValue(5, iCurRow)), 0);
+
+      if not VarIsNull(aSheet.Cells.GetValue(6, iCurRow)) then
+        xlsDQItem.DesignQuantity2
+                          := StrToFloatDef(Trim(aSheet.Cells.GetValue(6, iCurRow)), 0);
+
+      xlsDQItem.MemoContext := VarToStrDef(aSheet.Cells.GetValue(9, iCurRow), '');
+      Inc(iSerialNo);
+    end
+    else
+    begin
+      Val(sCode, iCode, iErrCode);
+      {当大于第三部分时不再导入}
+      if iCode > 3 then Break;
+
+      xlsItem := FExcelTree.AddNodeByCode(sCode, sB_Code);
+
+      if not Assigned(xlsItem) then Continue;
+
+      iSerialNo            := 1;
+      xlsItem.Name         := sName;
+      xlsItem.Units        := VarToStrDef(aSheet.Cells.GetValue(3, iCurRow), '');
+
+      if not VarIsNull(aSheet.Cells.GetValue(4, iCurRow)) then
+        xlsItem.Quantity   := StrToFloatDef(Trim(aSheet.Cells.GetValue(4, iCurRow)), 0);
+
+      if not VarIsNull(aSheet.Cells.GetValue(5, iCurRow)) then
+        xlsItem.Quantity1  := StrToFloatDef(Trim(aSheet.Cells.GetValue(5, iCurRow)), 0);
+
+      if not VarIsNull(aSheet.Cells.GetValue(6, iCurRow)) then
+        xlsItem.Quantity2  := StrToFloatDef(Trim(aSheet.Cells.GetValue(6, iCurRow)), 0);
+
+      if not VarIsNull(aSheet.Cells.GetValue(7, iCurRow)) then
+        xlsItem.Price      := StrToFloatDef(Trim(aSheet.Cells.GetValue(7, iCurRow)), 0);
+
+      if not VarIsNull(aSheet.Cells.GetValue(8, iCurRow)) then
+        xlsItem.TotalPrice := StrToFloatDef(Trim(aSheet.Cells.GetValue(8, iCurRow)), 0);
+
+      xlsItem.MemoString   := VarToStrDef(aSheet.Cells.GetValue(9, iCurRow), '');
+    end;
+
+  end;
+end;
+
+procedure TExcelImportor.ImportSheets;
+var
+  I: Integer;
+  iSheet: Integer;
+  ssSheet: TSpreadSheet;
+begin
+  for I := 0 to FCaptions.Count - 1 do
+  begin
+    iSheet := Integer(FCaptions.Objects[I]);
+    ssSheet := FMSExcel.Sheets.Spreadsheet(iSheet);
+    if IsBalanceFormat(ssSheet) then
+      ImportBalanceSheet(ssSheet)
+    else
+    if Is01_1Excel(ssSheet) then  // Added by GiLi 可以导入01-1表
+      Import01_1Excel(ssSheet)
+    else
+      ImportSheet(ssSheet);
+  end;
+end;
+
+procedure TExcelImportor.InitExcelTree;
+begin
+  FExcelTree.ViewBillTreeParts;
+  FExcelTree.AddFirstNode(FBillsData.BillsTree.FirstNode.ID);
+  FExcelTree.MaxNodeID := FBillsData.GetMaxBillsID;
+  FExcelTree.MaxDrawQID := FBillsData.GetMaxDrawingQuangtiyID;
+end;
+
+procedure TExcelImportor.InitSpecialItems(ASpecialItems: TStrings);
+begin
+  with ASpecialItems do
+  begin
+    Add('第一部分建筑安装工程费');
+    Add('第二部分设备及工具、器具购置费');
+    Add('第三部分工程建设其他费用');
+    Add('第一、二、三部分费用合计');
+    Add('预备费');
+    Add('预留费用');
+    Add('新增加费用项目(不作预备费基数)');
+    Add('其中:回收金额');
+    Add('预算总金额');
+    Add('概算总金额');
+    Add('公路基本造价');
+    Add('1.价差预备费');
+    Add('1.价差预留费');
+    Add('2.基本预备费');
+    Add('2.暂列金额(不含计日工总额)');
+    Add('建设期贷款利息');
+    Add('公路功能以外的工程费用(如有)');
+    Add('项目总造价');
+    Add('其他费用项目');
+  end;
+end;
+
+function TExcelImportor.Is01_1Excel(ASheet: TSpreadSheet): Boolean;
+begin
+  Result := (ASheet.Cells.UsedRowCount > 0) and (ASheet.Cells.UsedColCount > 5);
+  if Result then
+    Result := SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(0, 3), '')), '项') and
+              SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(1, 3), '')), '目') and
+              SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(2, 3), '')), '节') and
+              SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(3, 3), '')), '细目') and
+              SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(4, 3), '')), '清单子目号');
+end;
+
+function TExcelImportor.IsBalanceFormat(ASheet: TSpreadSheet): Boolean;
+begin
+  Result := (ASheet.Cells.UsedRowCount > 0) and (ASheet.Cells.UsedColCount > 7);
+  if Result then
+    Result := SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(0, 0), '')), '项') and
+              SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(1, 0), '')), '目') and
+              SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(2, 0), '')), '节') and
+              SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(3, 0), '')), '分项1') and
+              SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(4, 0), '')), '分项2') and
+              SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(5, 0), '')), '分项3') and
+              SameText(Trim(VarToStrDef(aSheet.Cells.GetValue(6, 0), '')), '分项4');
+end;
+
+function TExcelImportor.IsSpecialItem(const AString: string): Boolean;
+var
+  I: Integer;
+begin
+  if not Assigned(FSpecialItems) then
+  begin
+    Result := False;
+    Exit;
+  end;
+  if FSpecialItems.Count = 0 then
+  begin
+    Result := False;
+    Exit;
+  end;
+  for I:=0 to FSpecialItems.Count - 1 do
+  begin
+    if SameText(AString, FSpecialItems[I]) then
+    begin
+      Result := True;
+      Exit;
+    end;
+  end;
+  Result := False;
+end;
+
+function TExcelImportor.SelectExcelSheet: Boolean;
+begin
+  Result := ExportExFrm.SelectExcelSheet(FCaptions);
+  if Result and (FCaptions.Count = 0) then
+  begin
+    Result := False;
+    raise Exception.Create('选择工作表个数为0, 没有执行导入Excel操作.');
+  end;
+end;
+
+end.

+ 616 - 0
CU/ProjectFileManager.pas

@@ -0,0 +1,616 @@
+unit ProjectFileManager;
+
+interface
+
+uses
+  DB,
+  Classes,
+  Windows,
+  SysUtils,
+  CustomDoc,
+  ConstVarUnit,
+  ConstTypeUnit,
+  ConstMethodUnit,
+  ScProjectManager,
+  ProjectPropertyUnit,
+  ProjectManagerDM,
+  FileOprUnit,
+  ExportDecorateUnit,
+  SingleObjectAggregateUnit,
+  ImportDecorate;
+
+type
+
+  TProjectFileMgr = class
+  private
+    FFileOpr          : TFileOpr;
+    FProjectProperty  : TProjectProperty;
+    FProjectMgrDM     : TProjectMgrDM;
+    FProjectManager   : TProjectManager;
+    FCloseProjectProc : TNotifyEvent;
+    FOpenProjectProc  : TOpenProjectProc;
+    FImportFlag       : Integer;
+
+    
+    function GetBidLotProjectDS: TDataSet;
+    function GetGatherProjectDS: TDataSet;
+    function GetGatherBidDS: TDataSet;    
+    function CreateNewFile(const aFileName: string; var aNewName: string): Boolean;
+    function GetProjectFullPath(aProjKind: Integer): string;
+    procedure OpenDB;
+    function GetProjectPropertyFilePath(aProjKind: Integer; var aFilePath: string): Boolean;
+    procedure ReadProjectProperty(const aFilePath: string);
+    procedure CheckProjectOpen(const aFilePath: string);
+
+    procedure AddProject(aProjFile: TProjectFile; aProjList: TList; var aFullPath: string);
+    procedure GetProjectFile(aProjID: Integer; aProjList: TList);
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    function CreateNewProjectOpen(const aShortName: string; aProjType, aProjKind: Integer): string;
+    function CreateNewProjectForOneKey(const aShortName: string; var aID: Integer; aGatherID: Integer; aRaise: Boolean = True): string;
+    function CreateNewProject(const aShortName: string; var aID: Integer; aGatherID: Integer): string;
+    procedure OpenProject(aProjType, aProjKind: Integer);
+    procedure DeleteProject(aProjKind: Integer);
+
+    { Refresh ProjectProperty }
+    procedure RefreshProjectProperty(aProjKind: Integer);
+    procedure WriteProjectProperty;
+
+    function GetProjectFlag(aID: Integer): Integer;
+    { Locate }
+    procedure LocateBuildProject(aID: Integer);
+    function GetProjectName(aProjKind: Integer): string;
+    function GetParentID(aID: Integer): Integer;
+    function GetProjID(aProjKind: Integer): Integer;
+    procedure RenameProject(aProjKind: Integer; const aNewProjName: string);
+    { import and export }
+    procedure ImportProject(const aShortName, aFullPath: string; aProjKind: Integer);
+    procedure ExportProject(const aNewProjName: string; aProjKind: Integer; aIsSingle: Boolean);
+    procedure ImportProjects(const aFileName: string);
+    procedure ExportProjects(const aFileName: string; aProjKind: Integer);
+    { buildproject list }
+    procedure GetBuildProjectList(aString: TStrings);
+    procedure GetNameByID(aID: Integer; var aProjName, aFullName: string);
+    procedure GetBidLotsByID(aID: Integer; aStrings: TStrings);
+    { get build project recordno }
+    function GetBuildProjRecordNo: Integer;
+
+    property GatherProjectDS: TDataSet read GetGatherProjectDS;
+    property BidLotProjectDS: TDataSet read GetBidLotProjectDS;
+    property GatherBidDS: TDataSet read GetGatherBidDS;
+    property ProjectProperty: TProjectProperty read FProjectProperty write FProjectProperty;
+    property ProjectManager: TProjectManager read FProjectManager write FProjectManager;
+    property CloseProjectProc: TNotifyEvent read FCloseProjectProc write FCloseProjectProc;
+    property OpenProjectProc: TOpenProjectProc read FOpenProjectProc write FOpenProjectProc;
+    property ProjectMgrDM: TProjectMgrDM read FProjectMgrDM;
+    property FileOpr: TFileOpr read FFileOpr;
+  end;
+
+implementation
+
+{ TProjectFileMgr }
+
+procedure TProjectFileMgr.AddProject(aProjFile: TProjectFile;
+  aProjList: TList; var aFullPath: string);
+var
+  iLoop: Integer;
+  iFlag: Integer;
+  iGatherID: Integer;
+  strUnknowName: string;
+  strFullName: string;
+  sNewProjName: string;
+begin
+  repeat
+    strUnknowName := GetRandomName;
+  until not FProjectMgrDM.CheckUnknowNameExists(strUnknowName);
+
+  aFullPath := '我的清单\' + strUnknowName + '.smb';
+
+  iGatherID := 0;
+  for iLoop := 0 to aProjList.Count - 1 do
+  begin
+    if TProjectFile(aProjList.List^[iLoop]).ID = aProjFile.GatherID then
+    begin
+      iGatherID := TProjectFile(aProjList.List^[iLoop]).NewID;
+      Break;
+    end;
+  end;
+
+  if aProjList.Count = 0 then
+  begin
+    if aProjFile.Flag = 1 then
+    begin
+      sNewProjName := aProjFile.ProjName;
+      FProjectMgrDM.CheckSameProjectName(1, sNewProjName, False);
+      aProjFile.ProjName := sNewProjName;
+      FImportFlag := 1;
+    end
+    else if aProjFile.Flag = 2 then
+    begin
+      iGatherID := FProjectMgrDM.GetProjectID(1);
+      sNewProjName := aProjFile.ProjName;
+      FProjectMgrDM.CheckSameProject(iGatherID, sNewProjName, False);
+      aProjFile.ProjName := sNewProjName;
+      FImportFlag := 2;
+    end
+    else if aProjFile.Flag = 3 then
+    begin
+      iGatherID := FProjectMgrDM.GetProjectID(2);
+      sNewProjName := aProjFile.ProjName;
+      FProjectMgrDM.CheckSameProject(iGatherID, sNewProjName, False);
+      aProjFile.ProjName := sNewProjName;
+      FImportFlag := 3;
+    end;
+  end;
+
+  aProjFile.NewID := FProjectMgrDM.AddProject(aProjFile.ProjName, strUnknowName, aFullPath, iGatherID, aProjFile.Flag);
+  aProjList.Add(aProjFile);
+  aFullPath := FFileOpr.ExtractFilePath(ParamStr(0)) + aFullPath;
+end;
+
+function TProjectFileMgr.GetProjectFlag(aID: Integer): Integer;
+begin
+  Result := FProjectMgrDM.GetProjectFlag(aID);
+end;
+
+procedure TProjectFileMgr.CheckProjectOpen(const aFilePath: string);
+begin
+  if FProjectManager.CheckProjectExists(aFilePath) <> -1 then
+    raise Exception.Create('该项目已被打开,请先关闭项目再进行操作!');
+end;
+
+constructor TProjectFileMgr.Create;
+begin
+  FProjectProperty := TProjectProperty.Create;
+  FFileOpr := TFileOpr.Create;
+  FProjectMgrDM := TProjectMgrDM.Create(nil);
+  OpenDB;
+end;
+
+function TProjectFileMgr.CreateNewFile(const aFileName: string;
+  var aNewName: string): Boolean;
+var
+  strTemPath: string;
+begin
+  strTemPath := Format('%sData\%s', [FFileOpr.ExtractFilePath(ParamStr(0)), BudgetTemplateFile]);
+  aNewName := Format('%s我的清单\%s.smb', [FFileOpr.ExtractFilePath(ParamStr(0)), aFileName]);
+  Result := CopyFile(PChar(strTemPath), PChar(aNewName), True);
+end;
+
+function TProjectFileMgr.CreateNewProjectOpen(const aShortName: string;
+  aProjType, aProjKind: Integer): string;
+var
+  iID: Integer;
+  strUnknowName: string;
+  strFullName: string;
+  sShortName: string;
+  vProject: TProject;
+begin
+  sShortName := aShortName;
+  FProjectMgrDM.CheckSameProjectName(aProjKind, sShortName);
+
+  repeat
+    strUnknowName := GetRandomName;
+  until not FProjectMgrDM.CheckUnknowNameExists(strUnknowName);
+
+  strFullName := '我的清单\' + strUnknowName + '.smb';
+  iID := FProjectMgrDM.AddProject(aShortName, strUnknowName, strFullName, aProjKind);
+
+  CreateNewFile(strUnknowName, Result);
+
+  if Assigned(FOpenProjectProc) then
+    FOpenProjectProc(Result, aShortName, aProjType, iID);
+
+  vProject := FProjectManager.GetProjectByID(iID);
+  if aProjKind = 1 then
+  begin
+    FProjectMgrDM.RefreshBidLot(iID);
+    // 新建的项目不打开。这里采用打开后关闭的方式比较简单。
+    // 因为有些工作是必须在打开后才处理的,如初始化原始清单等。
+    vProject.ForceUndoSave := True;
+    FCloseProjectProc(vProject);
+  end
+  else if aProjKind = 2 then
+  begin
+    FProjectMgrDM.RefreshBidLot(GetProjID(1), True);
+    iID := FProjectManager.CheckProjectExists(GetProjectFullPath(1));
+
+    if iID <> -1 then
+    begin
+      SingleObjectAggregate.BidLotDM.Project := FProjectManager.Projects[iID];
+      SingleObjectAggregate.BidLotDM.Notify(boAdd, aShortName, strFullName);
+      SingleObjectAggregate.BidLotDM.SyncProjectView;
+    end;
+
+  end;
+
+end;
+
+function TProjectFileMgr.CreateNewProject(const aShortName: string;
+  var aID: Integer; aGatherID: Integer): string;
+var
+  strUnknowName: string;
+  strFullName  : string;
+  sShortName   : string;
+begin
+  sShortName := aShortName;
+  FProjectMgrDM.CheckSameProject(aGatherID, sShortName);
+
+  repeat
+    strUnknowName := GetRandomName;
+  until not FProjectMgrDM.CheckUnknowNameExists(strUnknowName);
+
+  strFullName := '我的清单\' + strUnknowName + '.smb';
+  aID := FProjectMgrDM.AddProject(aShortName, strUnknowName, strFullName, aGatherID, 3);
+
+  CreateNewFile(strUnknowName, strFullName);
+  Result := strFullName;
+  FProjectMgrDM.RefreshGatherBid;
+end;
+
+procedure TProjectFileMgr.DeleteProject(aProjKind: Integer);
+var
+  I, iIdx: Integer;
+  strFilePath: string;
+  sgFiles: TStrings;
+begin
+  sgFiles := TStringList.Create;
+  try
+    if aProjKind = 2 then
+    begin
+      iIdx := FProjectManager.CheckProjectExists(GetProjectFullPath(1));
+      if iIdx <> -1 then
+      begin
+        SingleObjectAggregate.BidLotDM.Project := FProjectManager.Projects[iIdx];
+        SingleObjectAggregate.BidLotDM.Notify(boDelete, GetProjectName(2), FProjectMgrDM.GetFileName(2));
+        SingleObjectAggregate.BidLotDM.SyncProjectView;
+      end;
+    end;
+
+    FProjectMgrDM.DeleteProjects(aProjKind, sgFiles);
+    for I := 0 to sgFiles.Count - 1 do
+    begin
+      strFilePath := sgFiles[I];
+      if strFilePath = '' then Continue;
+      strFilePath := FFileOpr.ExtractFilePath(ParamStr(0)) + strFilePath;
+      iIdx := FProjectManager.CheckProjectExists(strFilePath);
+      if iIdx <> -1 then
+        FCloseProjectProc(FProjectManager.Projects[iIdx]);
+      FFileOpr.DeleteFile(strFilePath);
+    end;
+  finally
+    sgFiles.Free;
+  end;
+//  if aProjKind <> 1 then
+//    FProjectMgrDM.RefreshBidLot(FProjectMgrDM.GetProjectID(1));
+end;
+
+destructor TProjectFileMgr.Destroy;
+begin
+  FFileOpr.Free;
+  FProjectProperty.Free;
+  FProjectMgrDM.Free;
+  inherited;
+end;
+
+procedure TProjectFileMgr.ExportProject(const aNewProjName: string;
+  aProjKind: Integer; aIsSingle: Boolean);
+var
+  strFullPath: string;
+  Decorator: TDecorator;
+begin
+  strFullPath := GetProjectFullPath(aProjKind);
+  if (aProjKind <> 1) or aIsSingle then
+  begin
+    FFileOpr.CopyFile(strFullPath, aNewProjName);
+
+    Decorator := TBillsDecorator.Create(aNewProjName, {$Include ThirdPart.inc});
+    try
+      Decorator.Decorate;
+    finally
+      Decorator.Free;
+    end;
+
+  end
+  else
+  begin
+    // nothing
+  end;
+end;
+
+procedure TProjectFileMgr.ExportProjects(const aFileName: string;
+  aProjKind: Integer);
+var
+  I, iProjID: Integer;
+  ProjFile: TProjectFile;
+  FileList: TList;
+begin
+  FileList := TList.Create;
+  try
+    if GetProjectFullPath(aProjKind) = '' then
+    begin
+      MessageError(0, '未定义项目不能导出!');
+      Exit;
+    end;
+    iProjID := FProjectMgrDM.GetProjectID(aProjKind);
+    GetProjectFile(iProjID, FileList);
+    TCustomProjectDoc.ExportProjects(aFileName, FileList);
+  finally
+    for I := 0 to FileList.Count - 1 do
+      TProjectFile(FileList.List^[I]).Free;
+    FileList.Free;
+  end;
+end;
+
+function TProjectFileMgr.GetBidLotProjectDS: TDataSet;
+begin
+  Result := FProjectMgrDM.aqBidLotProject;
+end;
+
+procedure TProjectFileMgr.GetBuildProjectList(aString: TStrings);
+begin
+  FProjectMgrDM.GetBuildProjectList(aString);
+end;
+
+function TProjectFileMgr.GetBuildProjRecordNo: Integer;
+begin
+  Result := FProjectMgrDM.GetBuildProjRecordNo - 1;
+end;
+
+function TProjectFileMgr.GetGatherBidDS: TDataSet;
+begin
+  Result := FProjectMgrDM.aqGatherBid;
+end;
+
+function TProjectFileMgr.GetGatherProjectDS: TDataSet;
+begin
+  Result := FProjectMgrDM.atGatherProject;
+end;
+
+procedure TProjectFileMgr.GetProjectFile(aProjID: Integer;
+  aProjList: TList);
+var
+  I: Integer;
+  iFlag: Integer;
+  iGatherID: Integer;
+  strProjName: string;
+  strFullPath: string;
+  ProjectFile: TProjectFile;
+  projectIDList: TList;
+begin
+  FProjectMgrDM.GetValues(aProjID, iGatherID, iFlag, strProjName, strFullPath);
+  if aProjID = -1 then Exit;
+  ProjectFile := TProjectFile.Create(nil);
+  ProjectFile.ID := aProjID;
+  ProjectFile.Flag := iFlag;
+  ProjectFile.GatherID := iGatherID;
+  ProjectFile.ProjName := strProjName;
+  ProjectFile.FullPath := FFileOpr.ExtractFilePath(ParamStr(0)) + strFullPath;
+  aProjList.Add(ProjectFile);
+
+  projectIDList := TList.Create;
+  try
+    FProjectMgrDM.GetBidLots(aProjID, projectIDList);
+    for I := 0 to projectIDList.Count - 1 do
+      GetProjectFile(Integer(projectIDList[I]), aProjList);
+  finally
+    projectIDList.Free;
+  end;
+end;
+
+function TProjectFileMgr.GetProjectFullPath(aProjKind: Integer): string;
+var
+  strFilePath: string;
+  sFullName: string;
+begin
+  strFilePath := ParamStr(0);
+  strFilePath := FFileOpr.ExtractFilePath(strFilePath);
+  sFullName := FProjectMgrDM.GetFileName(aProjKind);
+  if sFullName <> '' then
+    Result := strFilePath + sFullName
+  else
+    Result := '';
+end;
+
+function TProjectFileMgr.GetProjectName(aProjKind: Integer): string;
+begin
+  Result := FProjectMgrDM.GetProjectName(aProjKind);
+end;
+
+procedure TProjectFileMgr.ImportProject(const aShortName, aFullPath: string; aProjKind: Integer);
+
+  procedure DecorateExprs(const AFileName: string);
+  var
+    imDecorator: TImportDecorator;
+  begin
+    imDecorator := TImportDecorator.Create(AFileName);
+    try
+      imDecorator.Decorate;
+    finally
+      imDecorator.Free;
+    end;
+  end;
+
+var
+  strUnknowName: string;
+  strFullName: string;
+  sShortName: string;
+begin
+  sShortName := aShortName;
+  FProjectMgrDM.CheckSameProjectName(aProjKind, sShortName);
+  
+  repeat
+    strUnknowName := GetRandomName;
+  until not FProjectMgrDM.CheckUnknowNameExists(strUnknowName);
+
+  strFullName := '我的清单\' + strUnknowName + '.smb';
+  FProjectMgrDM.AddProject(aShortName, strUnknowName, strFullName, aProjKind);
+
+  strFullName := Format('%s%s', [FFileOpr.ExtractFilePath(ParamStr(0)), strFullName]);
+  FFileOpr.CopyFile(aFullPath, strFullName);
+  DecorateExprs(strFullName);
+
+  FProjectMgrDM.RefreshBidLot(GetProjID(1), True);
+end;
+
+procedure TProjectFileMgr.ImportProjects(const aFileName: string);
+begin
+  TCustomProjectDoc.ImportProjects(aFileName, AddProject);
+  
+  if FImportFlag = 1 then
+    FProjectMgrDM.RefreshBuildProject
+  else if FImportFlag = 2 then
+    FProjectMgrDM.RefreshBidLot(GetProjID(1), True)
+  else
+    FProjectMgrDM.RefreshGatherBid(True);
+end;
+
+procedure TProjectFileMgr.LocateBuildProject(aID: Integer);
+begin
+  FProjectMgrDM.LocateBuildProject(aID);
+end;
+
+procedure TProjectFileMgr.OpenDB;
+var
+  strDBName: string;
+begin
+  strDBName := FFileOpr.ExtractFilePath(ParamStr(0));
+  strDBName := strDBName + 'Data\ProjectManager.dat';
+  if FFileOpr.FileExists(strDBName) then
+    FProjectMgrDM.OpenDataBase(strDBName);
+end;
+
+procedure TProjectFileMgr.OpenProject(aProjType, aProjKind: Integer);
+begin
+  if FProjectMgrDM.CanOpen(aProjKind) then
+  begin
+    FProjectProperty.CloseArcFile;
+    FOpenProjectProc(GetProjectFullPath(aProjKind),
+              FProjectMgrDM.GetProjectName(aProjKind),
+              aProjType,
+              FProjectMgrDM.GetProjectID(aProjKind));
+    FProjectProperty.Connection := FProjectManager.ActiveProject.Connection;
+  end;
+end;
+
+procedure TProjectFileMgr.RenameProject(aProjKind: Integer;
+  const aNewProjName: string);
+var
+  sNewProjName: string;
+begin
+  sNewProjName := aNewProjName;
+  CheckProjectOpen(GetProjectFullPath(aProjKind));
+  FProjectMgrDM.CheckSameProjectName(aProjKind, sNewProjName);
+  FProjectMgrDM.RenameProject(aProjKind, aNewProjName);
+  
+  if (aProjKind = 2) and (GetProjID(1) <> 1) then
+    SingleObjectAggregate.BidLotDM.Notify(boReName, aNewProjName, FProjectMgrDM.GetFileName(2));
+end;
+
+procedure TProjectFileMgr.GetBidLotsByID(aID: Integer; aStrings: TStrings);
+begin
+  FProjectMgrDM.GetBidLotsByID(aID, aStrings);
+end;
+
+procedure TProjectFileMgr.GetNameByID(aID: Integer; var aProjName,
+  aFullName: string);
+begin
+  FProjectMgrDM.GetNameByID(aID, aProjName, aFullName);
+end;
+
+procedure TProjectFileMgr.RefreshProjectProperty(aProjKind: Integer);
+var
+  sFilePath: string;
+begin
+  if not GetProjectPropertyFilePath(aProjKind, sFilePath) then Exit;
+
+  if sFilePath <> '' then
+    ReadProjectProperty(sFilePath)
+  else
+  begin
+    FProjectProperty.InitProjectProperty;
+    FProjectProperty.Connection := nil;
+  end;
+end;
+
+procedure TProjectFileMgr.ReadProjectProperty(const aFilePath: string);
+var
+  iIdx: Integer;
+begin
+  if not Assigned(FProjectManager) then Exit;
+  
+  iIdx := FProjectManager.CheckProjectExists(aFilePath);
+  if iIdx <> -1 then
+  begin
+    FProjectProperty.Connection := FProjectManager.Projects[iIdx].Connection;
+    FProjectProperty.GetProjectProperty;
+  end
+  else
+  begin
+    FProjectProperty.GetProjectProperty(aFilePath);
+  end;
+end;
+
+procedure TProjectFileMgr.WriteProjectProperty;
+//var
+//  iIdx: Integer;
+begin
+//  iIdx := FProjectManager.CheckProjectExists(FProjectProperty.FileName);
+//  if iIdx <> -1 then
+//    FProjectProperty.Connection := FProjectManager.Projects[iIdx].Connection;
+  
+  FProjectProperty.SaveProperty;
+end;
+
+function TProjectFileMgr.GetProjID(aProjKind: Integer): Integer;
+begin
+  Result := FProjectMgrDM.GetProjectID(aProjKind);
+end;
+
+function TProjectFileMgr.GetParentID(aID: Integer): Integer;
+begin
+  Result := FProjectMgrDM.GetParentID(aID);
+end;
+
+function TProjectFileMgr.GetProjectPropertyFilePath(aProjKind: Integer; var aFilePath: string): Boolean;
+begin
+  Result := True;
+
+  if aProjKind in [1, 2] then
+  begin
+    aFilePath := GetProjectFullPath(aProjKind);
+  end
+  else if aProjKind = 3 then
+  begin
+    aFilePath := GetProjectFullPath(3);
+  end
+  else
+    Result := False;
+end;
+
+function TProjectFileMgr.CreateNewProjectForOneKey(
+  const aShortName: string; var aID: Integer; aGatherID: Integer;
+  aRaise: Boolean): string;
+var
+  strUnknowName: string;
+  strFullName  : string;
+  sShortName   : string;
+begin
+  sShortName := aShortName;
+
+  repeat
+    strUnknowName := GetRandomName;
+  until not FProjectMgrDM.CheckUnknowNameExists(strUnknowName);
+
+  strFullName := '我的清单\' + strUnknowName + '.smb';
+  aID := FProjectMgrDM.AddProject(aShortName, strUnknowName, strFullName, aGatherID, 3);
+
+  CreateNewFile(strUnknowName, strFullName);
+  Result := strFullName;
+  FProjectMgrDM.RefreshGatherBid;
+end;
+
+
+end.

Разница между файлами не показана из-за своего большого размера
+ 1272 - 0
CU/ProjectMergeSplitUnit.pas


+ 182 - 0
CU/ProjectPropertyThread.pas

@@ -0,0 +1,182 @@
+unit ProjectPropertyThread;
+
+interface
+
+uses
+  Classes,
+  ZjGrid,
+  Windows,
+  ProjectFileManager;
+
+type
+  TProjPtyThread = class(TThread)
+  private
+    FProjKind        : Integer;
+    FGrid            : TZJGrid;
+    FProjectFileMgr  : TProjectFileMgr;
+    FReadProperty    : Boolean;
+    FThreadList      : TThreadList;
+
+    procedure WriteToGrid;
+    procedure ReadFromGrid;
+
+    procedure RemoveFormList;
+    procedure AddToList;
+  protected
+    procedure Execute; override;
+  public
+    constructor Create(aProjKind      : Integer;
+                       aGrid          : TZJGrid;
+                       aProFileMgr    : TProjectFileMgr;
+                       AReadProperty  : Boolean;
+                       aThreadList    : TThreadList);
+                       
+    destructor Destroy; override;
+  end;
+
+implementation
+
+uses ProjectPropertyUnit;
+
+{ TProjPtyThread }
+
+var
+  gl_CriticalSection_True: TRTLCriticalSection;
+  gl_CriticalSection_False: TRTLCriticalSection;
+
+procedure TProjPtyThread.AddToList;
+var
+  thrList: TList;
+begin
+  thrList := FThreadList.LockList;
+  try
+    thrList.Add(Self);
+  finally
+    FThreadList.UnlockList;
+  end;
+end;
+
+constructor TProjPtyThread.Create(aProjKind      : Integer;
+                                  aGrid          : TZJGrid;
+                                  aProFileMgr    : TProjectFileMgr;
+                                  AReadProperty  : Boolean;
+                                  aThreadList    : TThreadList);
+begin
+  FProjKind       := aProjKind;
+  FGrid           := aGrid;
+  FProjectFileMgr := aProFileMgr;
+  FReadProperty   := AReadProperty;
+  FThreadList     := aThreadList;
+  
+  AddToList;
+
+  FreeOnTerminate := True;
+  inherited Create(False);
+end;
+
+destructor TProjPtyThread.Destroy;
+begin
+  RemoveFormList;
+  inherited;
+end;
+
+procedure TProjPtyThread.Execute;
+
+  procedure ExecuteReadProperty;
+  begin
+    EnterCriticalSection(gl_CriticalSection_True);
+    try
+      FProjectFileMgr.RefreshProjectProperty(FProjKind);
+      Synchronize(WriteToGrid);
+    finally
+      LeaveCriticalSection(gl_CriticalSection_True);
+    end;
+  end;
+
+  procedure ExecuteWriteProperty;
+  begin
+    EnterCriticalSection(gl_CriticalSection_False);
+    try
+      Synchronize(ReadFromGrid);
+      FProjectFileMgr.WriteProjectProperty;
+    finally
+      LeaveCriticalSection(gl_CriticalSection_False);
+    end;
+  end;
+
+begin
+  inherited;
+  
+  if FReadProperty then
+    ExecuteReadProperty
+  else
+    ExecuteWriteProperty;
+end;
+
+procedure TProjPtyThread.ReadFromGrid;
+begin
+  FProjectFileMgr.ProjectProperty.ProjectType := FGrid.Cells[1, 1].Text;
+  FProjectFileMgr.ProjectProperty.BuildProjectName := FGrid.Cells[1, 2].Text;
+  FProjectFileMgr.ProjectProperty.BudgetProjectName := FGrid.Cells[1, 3].Text;
+  FProjectFileMgr.ProjectProperty.WeaveRange := FGrid.Cells[1, 4].Text;
+  FProjectFileMgr.ProjectProperty.BuildUnit := FGrid.Cells[1, 5].Text;
+  FProjectFileMgr.ProjectProperty.ProjectSite := FGrid.Cells[1, 6].Text;
+  FProjectFileMgr.ProjectProperty.WeaveDate := FGrid.Cells[1, 7].Text;
+  FProjectFileMgr.ProjectProperty.WeavePerson := FGrid.Cells[1, 8].Text;
+  FProjectFileMgr.ProjectProperty.WeaveCode := FGrid.Cells[1, 9].Text;
+  FProjectFileMgr.ProjectProperty.CheckPerson := FGrid.Cells[1, 10].Text;
+  FProjectFileMgr.ProjectProperty.CheckCode := FGrid.Cells[1, 11].Text;
+  FProjectFileMgr.ProjectProperty.TenderPerson := FGrid.Cells[1, 12].Text;
+  FProjectFileMgr.ProjectProperty.DataFileCode := FGrid.Cells[1, 13].Text;
+  FProjectFileMgr.ProjectProperty.RoadLevel := FGrid.Cells[1, 14].Text;
+  FProjectFileMgr.ProjectProperty.FirstPeg := FGrid.Cells[1, 15].Text;
+  FProjectFileMgr.ProjectProperty.LastPeg := FGrid.Cells[1, 16].Text;
+  FProjectFileMgr.ProjectProperty.RouteLength := FGrid.Cells[1, 17].Text;
+  FProjectFileMgr.ProjectProperty.RouteWidth := FGrid.Cells[1, 18].Text;
+end;
+
+procedure TProjPtyThread.RemoveFormList;
+var
+  thrList: TList;
+begin
+  thrList := FThreadList.LockList;
+  try
+    thrList.Remove(Self);
+  finally
+    FThreadList.UnlockList;
+  end;
+end;
+
+procedure TProjPtyThread.WriteToGrid;
+begin
+  FGrid.BeginUpdate;
+  FGrid.Cells[1, 1].Text := FProjectFileMgr.ProjectProperty.ProjectType;
+  FGrid.Cells[1, 2].Text := FProjectFileMgr.ProjectProperty.BuildProjectName;
+  FGrid.Cells[1, 3].Text := FProjectFileMgr.ProjectProperty.BudgetProjectName;
+  FGrid.Cells[1, 4].Text := FProjectFileMgr.ProjectProperty.WeaveRange;
+  FGrid.Cells[1, 5].Text := FProjectFileMgr.ProjectProperty.BuildUnit;
+  FGrid.Cells[1, 6].Text := FProjectFileMgr.ProjectProperty.ProjectSite;
+  FGrid.Cells[1, 7].Text := FProjectFileMgr.ProjectProperty.WeaveDate;
+  FGrid.Cells[1, 8].Text := FProjectFileMgr.ProjectProperty.WeavePerson;
+  FGrid.Cells[1, 9].Text := FProjectFileMgr.ProjectProperty.WeaveCode;
+  FGrid.Cells[1, 10].Text := FProjectFileMgr.ProjectProperty.CheckPerson;
+  FGrid.Cells[1, 11].Text := FProjectFileMgr.ProjectProperty.CheckCode;
+  FGrid.Cells[1, 12].Text := FProjectFileMgr.ProjectProperty.TenderPerson;
+  FGrid.Cells[1, 13].Text := FProjectFileMgr.ProjectProperty.DataFileCode;
+  FGrid.Cells[1, 14].Text := FProjectFileMgr.ProjectProperty.RoadLevel;
+  FGrid.Cells[1, 15].Text := FProjectFileMgr.ProjectProperty.FirstPeg;
+  FGrid.Cells[1, 16].Text := FProjectFileMgr.ProjectProperty.LastPeg;
+  FGrid.Cells[1, 17].Text := FProjectFileMgr.ProjectProperty.RouteLength;
+  FGrid.Cells[1, 18].Text := FProjectFileMgr.ProjectProperty.RouteWidth;
+  FGrid.EndUpdate;
+end;
+
+initialization
+  InitializeCriticalSection(gl_CriticalSection_True);
+  InitializeCriticalSection(gl_CriticalSection_False);
+
+finalization
+  DeleteCriticalSection(gl_CriticalSection_True);
+  DeleteCriticalSection(gl_CriticalSection_False);
+
+end.

+ 516 - 0
CU/ProjectPropertyUnit.pas

@@ -0,0 +1,516 @@
+unit ProjectPropertyUnit;
+
+interface
+
+uses
+  ADODB,
+  ScFileArchiver,
+  SysUtils;
+
+type
+  TProjectProperty = class
+  private
+    FBuildProjectName: string;
+    FBudgetProjectName: string;
+    { 标段类型 }
+    FProjectType  : string;
+    { 编制范围 }
+    FWeaveRange   : string;
+    { 建设单位 }
+    FBuildUnit    : string;
+    { 工程地点 }
+    FProjectSite  : string;
+    { 编制日期 }
+    FWeaveDate    : string;
+    { 编制人 }
+    FWeavePerson  : string;
+    { 编制人证号 }
+    FWeaveCode    : string;
+    { 复核人 }
+    FCheckPerson  : string;
+    { 复核人证号 }
+    FCheckCode    : string;
+    { 投标人 }
+    FTenderPerson : string;
+    { 数据文件号 }
+    FDataFileCode : string;
+    { 公路等级 }
+    FRoadLevel    : string;
+    { 起点桩号 }
+    FFirstPeg     : string;
+    { 终点桩号 }
+    FLastPeg      : string;
+    { 路线长度 }
+    FRouteLength  : string;
+    { 路线宽度 }
+    FRouteWidth   : string;
+
+    FExpressMode  : Integer;
+
+    FQuery        : TADOQuery;
+    FDoQuery      : TADOQuery;
+    FConnection   : TADOConnection;
+    FArchiver     : TScProjectFileArchiver;
+    
+    function OpenArcFile(const aFilePath: string): Boolean;
+    procedure ExecuteSql(aQuery: TADOQuery; const aSql: string);
+    procedure OpenSql(aQuery: TADOQuery; const aSql: string);
+    { Access Tables }
+    procedure WriteProjectData;
+    procedure WriteProjProperty;
+    procedure WriteProjFloatProperty;
+    procedure ReadProjectData;
+    procedure ReadProjProperty;
+    procedure ReadProjFloatProperty;
+    { projproperty }
+    function GetMaxProjPropertyID: Integer;
+    function CheckProjProperty(const aName: string): Boolean;
+    procedure WriteProperty(var aMaxID: Integer; const aTableName, aName, aItemValue: string);
+    procedure UpdateProjProperty(const aTableName, aName, aItemValue: string);
+    procedure InsertProjProperty(aID: Integer; const aTableName, aName, aItemValue: string);
+
+    procedure SetBuildUnit(const Value: string);
+    procedure SetCheckCode(const Value: string);
+    procedure SetCheckPerson(const Value: string);
+    procedure SetDataFileCode(const Value: string);
+    procedure SetFirstPeg(const Value: string);
+    procedure SetLastPeg(const Value: string);
+    procedure SetProjectSite(const Value: string);
+    procedure SetProjectType(const Value: string);
+    procedure SetRoadLevel(const Value: string);
+    procedure SetRouteLength(const Value: string);
+    procedure SetRouteWidth(const Value: string);
+    procedure SetTenderPerson(const Value: string);
+    procedure SetWeaveCode(const Value: string);
+    procedure SetWeaveDate(const Value: string);
+    procedure SetWeavePerson(const Value: string);
+    procedure SetWeaveRange(const Value: string);
+    procedure SetConnection(const Value: TADOConnection);
+    procedure SetExpressMode(const Value: Integer);
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    procedure CloseArcFile;
+    procedure SaveProperty;
+    procedure InitProjectProperty;
+    // project has not opened yet
+    procedure GetProjectProperty(const aFilePath: string); overload;
+    // project has opened
+    procedure GetProjectProperty; overload;
+
+    property Connection: TADOConnection read FConnection write SetConnection;
+
+    property BuildProjectName: string read FBuildProjectName write FBuildProjectName;
+    property BudgetProjectName: string read FBudgetProjectName write FBudgetProjectName;
+    { 标段类型 }
+    property ProjectType: string read FProjectType write SetProjectType;
+    { 编制范围 }
+    property WeaveRange: string read FWeaveRange write SetWeaveRange;
+    { 建设单位 }
+    property BuildUnit: string read FBuildUnit write SetBuildUnit;
+    { 工程地点 }
+    property ProjectSite: string read FProjectSite write SetProjectSite;
+    { 编制日期 }
+    property WeaveDate: string read FWeaveDate write SetWeaveDate;
+    { 编制人 }
+    property WeavePerson: string read FWeavePerson write SetWeavePerson;
+    { 编制人证号 }
+    property WeaveCode: string read FWeaveCode write SetWeaveCode;
+    { 复核人 }
+    property CheckPerson: string read FCheckPerson write SetCheckPerson;
+    { 复核人证号 }
+    property CheckCode: string read FCheckCode write SetCheckCode;
+    { 投标人 }
+    property TenderPerson: string read FTenderPerson write SetTenderPerson;
+    { 数据文件号 }
+    property DataFileCode: string read FDataFileCode write SetDataFileCode;
+    { 公路等级 }
+    property RoadLevel: string read FRoadLevel write SetRoadLevel;
+    { 起点桩号 }
+    property FirstPeg: string read FFirstPeg write SetFirstPeg;
+    { 终点桩号 }
+    property LastPeg: string read FLastPeg write SetLastPeg;
+    { 路线长度 }
+    property RouteLength: string read FRouteLength write SetRouteLength;
+    { 路线宽度 }
+    property RouteWidth: string read FRouteWidth write SetRouteWidth;
+
+    property ExpressMode: Integer read FExpressMode write SetExpressMode;
+  end;
+
+implementation
+
+uses DB;
+
+{ TProjectProperty }
+
+function TProjectProperty.CheckProjProperty(
+  const aName: string): Boolean;
+var
+  sSql: string;
+begin
+  sSql := Format('Select * From ProjProperty Where Name = ''%s''', [aName]);
+  OpenSql(FDoQuery, sSql);
+  Result := FDoQuery.RecordCount > 0;
+end;
+
+procedure TProjectProperty.CloseArcFile;
+begin
+  if FArchiver.IsOpened then
+    FArchiver.CloseFile;
+end;
+
+constructor TProjectProperty.Create;
+begin
+  FQuery := TADOQuery.Create(nil);
+  FDoQuery := TADOQuery.Create(nil);
+  FArchiver := TScProjectFileArchiver.Create;
+end;
+
+destructor TProjectProperty.Destroy;
+begin
+  CloseArcFile;
+  FQuery.Free;
+  FDoQuery.Free;
+  FArchiver.Free;
+  inherited;
+end;
+
+procedure TProjectProperty.ExecuteSql(aQuery: TADOQuery; const aSql: string);
+begin
+  with aQuery do
+  begin
+    SQL.Clear;
+    SQL.Add(aSql);
+    ExecSQL;
+  end;
+end;
+
+function TProjectProperty.GetMaxProjPropertyID: Integer;
+var
+  sSql: string;
+begin
+  sSql := 'Select Max(ID) as ID From ProjProperty';
+  OpenSql(FDoQuery, sSql);
+  Result := FDoQuery.FieldByName('ID').AsInteger + 1;
+end;
+
+procedure TProjectProperty.GetProjectProperty;
+begin
+  InitProjectProperty;
+  ReadProjectData;
+  ReadProjProperty;
+  ReadProjFloatProperty;
+end;
+
+procedure TProjectProperty.GetProjectProperty(const aFilePath: string);
+begin
+  CloseArcFile;
+  if not OpenArcFile(aFilePath) then Exit;
+
+  FConnection := FArchiver.Connection;
+  FQuery.Connection := FConnection;
+  FDoQuery.Connection := FConnection;
+  GetProjectProperty;
+end;
+
+procedure TProjectProperty.InitProjectProperty;
+begin
+  FBudgetProjectName := '';
+  FProjectType  := '';
+  FWeaveRange   := '';
+  FBuildUnit    := '';
+  FProjectSite  := '';
+  FWeaveDate    := '';
+  FWeavePerson  := '';
+  FWeaveCode    := '';
+  FCheckPerson  := '';
+  FCheckCode    := '';
+  FTenderPerson := '';
+  FDataFileCode := '';
+  FRoadLevel    := '';
+  FFirstPeg     := '';
+  FLastPeg      := '';
+  FRouteLength  := '';
+  FRouteWidth   := '';
+  FExpressMode  := 1;
+end;
+
+procedure TProjectProperty.InsertProjProperty(aID: Integer;
+  const aTableName, aName, aItemValue: string);
+var
+  sSql: string;
+begin
+  sSql := Format('Insert Into %s (ID, Name, ItemValue) Values (%d, ''%s'', ''%s'')',
+                 [aTableName, aID, aName, aItemValue]);
+  ExecuteSql(FDoQuery, sSql);
+end;
+
+function TProjectProperty.OpenArcFile(const aFilePath: string): Boolean;
+begin
+  FArchiver.FileName := aFilePath;
+  Result := FArchiver.OpenFile;
+end;
+
+procedure TProjectProperty.OpenSql(aQuery: TADOQuery; const aSql: string);
+begin
+  with aQuery do
+  begin
+    SQL.Clear;
+    SQL.Add(aSql);
+    Open;
+  end;
+end;
+
+procedure TProjectProperty.ReadProjectData;
+begin
+  OpenSql(FQuery, 'Select * From ProjData');
+  with FQuery do
+  begin
+    FBuildProjectName := FieldByName('BuildProjectName').AsString;
+    FBudgetProjectName := FieldByName('BudgetProjectName').AsString;
+    FWeaveRange   := FieldByName('EditRange').AsString;
+    FBuildUnit    := FieldByName('BuildUnit').AsString;
+    FProjectSite  := FieldByName('ProjectLocation').AsString;
+    FWeaveDate    := FieldByName('EditDate').AsString;
+    FWeavePerson  := FieldByName('Author').AsString;
+    FWeaveCode    := FieldByName('AuthorCertificate').AsString;
+    FCheckPerson  := FieldByName('Auditor').AsString;
+    FCheckCode    := FieldByName('AuditorCertificate').AsString;
+    FTenderPerson := FieldByName('Bidder').AsString;        
+  end;
+end;
+
+procedure TProjectProperty.ReadProjFloatProperty;
+begin
+  OpenSql(FQuery, 'Select * From ProjFloatProperty Where Name = ''ROADLENGTH''');
+  if FQuery.RecordCount > 0 then
+    FRouteLength := FQuery.FieldByName('ItemValue').AsString;
+end;
+
+procedure TProjectProperty.ReadProjProperty;
+begin
+  OpenSql(FQuery, 'Select * From ProjProperty');
+  with FQuery do
+  begin
+    First;
+    while not Eof do
+    begin
+      if FieldByName('Name').AsString = 'PROJTYPE' then
+      begin
+        if FieldByName('ItemValue').AsString = '5' then
+          FProjectType := '三级清单预算'
+        else
+          FProjectType := '';
+//          FProjectType := '旧版本';
+      end
+      else if FieldByName('Name').AsString = 'DATAFILENO' then
+        FDataFileCode := FieldByName('ItemValue').AsString
+      else if FieldByName('Name').AsString = 'ROADLEVEL' then
+        FRoadLevel := FieldByName('ItemValue').AsString
+      else if FieldByName('Name').AsString = 'STARTCODE' then
+        FFirstPeg := FieldByName('ItemValue').AsString
+      else if FieldByName('Name').AsString = 'ENDCODE' then
+        FLastPeg := FieldByName('ItemValue').AsString
+      else if FieldByName('Name').AsString = 'ROADWIDTH' then
+        FRouteWidth := FieldByName('ItemValue').AsString
+      else if FieldByName('Name').AsString = 'ExpressMode' then
+        FExpressMode := FieldByName('ItemValue').AsInteger;
+      Next;
+    end;
+  end;
+end;
+
+procedure TProjectProperty.SaveProperty;
+begin
+  if FConnection = nil then Exit;
+
+  WriteProjectData;
+  WriteProjProperty;
+  WriteProjFloatProperty;
+  if FArchiver.IsOpened then
+    FArchiver.Save;
+end;
+
+procedure TProjectProperty.SetBuildUnit(const Value: string);
+begin
+  FBuildUnit := Value;
+end;
+
+procedure TProjectProperty.SetCheckCode(const Value: string);
+begin
+  FCheckCode := Value;
+end;
+
+procedure TProjectProperty.SetCheckPerson(const Value: string);
+begin
+  FCheckPerson := Value;
+end;
+
+procedure TProjectProperty.SetConnection(const Value: TADOConnection);
+begin
+  FConnection := Value;
+  FQuery.Connection := FConnection;
+  FDoQuery.Connection := FConnection;
+end;
+
+procedure TProjectProperty.SetDataFileCode(const Value: string);
+begin
+  FDataFileCode := Value;
+end;
+
+procedure TProjectProperty.SetExpressMode(const Value: Integer);
+begin
+  FExpressMode := Value;
+end;
+
+procedure TProjectProperty.SetFirstPeg(const Value: string);
+begin
+  FFirstPeg := Value;
+end;
+
+procedure TProjectProperty.SetLastPeg(const Value: string);
+begin
+  FLastPeg := Value;
+end;
+
+procedure TProjectProperty.SetProjectSite(const Value: string);
+begin
+  FProjectSite := Value;
+end;
+
+procedure TProjectProperty.SetProjectType(const Value: string);
+begin
+  FProjectType := Value;
+//  WriteProjProperty;
+end;
+
+procedure TProjectProperty.SetRoadLevel(const Value: string);
+begin
+  FRoadLevel := Value;
+//  WriteProjProperty;
+end;
+
+procedure TProjectProperty.SetRouteLength(const Value: string);
+begin
+  FRouteLength := Value;
+//  WriteProjFloatProperty;
+end;
+
+procedure TProjectProperty.SetRouteWidth(const Value: string);
+begin
+  FRouteWidth := Value;
+//  WriteProjProperty;  
+end;
+
+procedure TProjectProperty.SetTenderPerson(const Value: string);
+begin
+  FTenderPerson := Value;
+end;
+
+procedure TProjectProperty.SetWeaveCode(const Value: string);
+begin
+  FWeaveCode := Value;
+//  WriteProjectData;
+end;
+
+procedure TProjectProperty.SetWeaveDate(const Value: string);
+begin
+  FWeaveDate := Value;
+//  WriteProjectData;
+end;
+
+procedure TProjectProperty.SetWeavePerson(const Value: string);
+begin
+  FWeavePerson := Value;
+//  WriteProjectData;
+end;
+
+procedure TProjectProperty.SetWeaveRange(const Value: string);
+begin
+  FWeaveRange := Value;
+//  WriteProjectData;
+end;
+
+procedure TProjectProperty.UpdateProjProperty(const aTableName, aName,
+  aItemValue: string);
+var
+  sSql: string;
+begin
+  sSql := Format('Update %s Set ItemValue = ''%s'' Where Name = ''%s''',
+                 [aTableName, aItemValue, aName]);
+  ExecuteSql(FDoQuery, sSql);
+end;
+
+procedure TProjectProperty.WriteProjectData;
+var
+  sSql: string;
+begin
+  sSql := Format('Update ProjData Set ' +
+                 'BuildProjectName = ''%s'', ' +
+                 'BudgetProjectName = ''%s'', ' +
+                 'EditRange = ''%s'', ' +
+                 'BuildUnit = ''%s'', ' +
+                 'ProjectLocation = ''%s'', ' +
+                 'EditDate = ''%s'', ' +
+                 'Author = ''%s'', ' +
+                 'AuthorCertificate = ''%s'', ' +
+                 'Auditor = ''%s'', ' +
+                 'AuditorCertificate = ''%s'', ' +
+                 'Bidder = ''%s''',
+                 [FBuildProjectName, FBudgetProjectName, FWeaveRange,
+                  FBuildUnit, FProjectSite,
+                  FWeaveDate, FWeavePerson, FWeaveCode,
+                  FCheckPerson, FCheckCode, FTenderPerson]);
+  if not Assigned(FQuery.Connection) then
+    FQuery.Connection := FConnection;
+  ExecuteSql(FQuery, sSql);
+end;
+
+procedure TProjectProperty.WriteProjFloatProperty;
+var
+  sSql: string;
+begin               
+  sSql := Format('Update ProjFloatProperty Set ItemValue = %0.3f Where Name = ''ROADLENGTH''',
+                 [StrToFloatDef(FRouteLength, 0)]);
+
+  ExecuteSql(FQuery, sSql);
+end;
+
+procedure TProjectProperty.WriteProjProperty;
+var
+  iMaxID: Integer;
+  sSql: string;
+  sProjType: string;
+begin
+  iMaxID := GetMaxProjPropertyID;
+
+  if SameText(FProjectType, '三级清单预算') then
+    sProjType := '5'
+  else
+    sProjType := '6';
+  WriteProperty(iMaxID, 'ProjProperty', 'PROJTYPE', sProjType);
+  WriteProperty(iMaxID, 'ProjProperty', 'DATAFILENO', FDataFileCode);
+  WriteProperty(iMaxID, 'ProjProperty', 'ROADLEVEL', FRoadLevel);
+  WriteProperty(iMaxID, 'ProjProperty', 'STARTCODE', FFirstPeg);
+  WriteProperty(iMaxID, 'ProjProperty', 'ENDCODE', FLastPeg);
+  WriteProperty(iMaxID, 'ProjProperty', 'ROADWIDTH', FRouteWidth);
+  WriteProperty(iMaxID, 'ProjProperty', 'ExpressMode', IntToStr(FExpressMode));
+end;
+
+procedure TProjectProperty.WriteProperty(var aMaxID: Integer;
+  const aTableName, aName, aItemValue: string);
+begin
+  if CheckProjProperty(aName) then
+  begin
+    UpdateProjProperty(aTableName, aName, aItemValue);
+  end
+  else
+  begin
+    InsertProjProperty(aMaxID, aTableName, aName, aItemValue);
+    Inc(aMaxID);
+  end;
+end;
+
+end.

+ 611 - 0
CU/ScAutoUpdateUnit.pas

@@ -0,0 +1,611 @@
+unit ScAutoUpdateUnit;
+
+interface
+
+uses
+  DB, ADODB, ScFileArchiver, ScTablesUnit, Classes;
+
+const
+  MaxFieldCount = 512;
+  PrimaryKey = 'PrimaryKey';
+  
+type
+  PFieldDefs = ^TFieldDefs;
+
+  TFieldDefs = array [0..MaxFieldCount - 1] of TScFieldDef;
+
+  PTableDef = ^TTableDef;
+
+  // 表定义结构
+  TTableDef = record
+    // 表名
+    TableName: string;
+    // 字段数
+    FieldCount: Integer;
+    // 字段结构数组
+    FieldDefs: PFieldDefs;
+    // 是否需要重新创建
+    Recreate: Boolean;
+    // 重新创建主键
+    RecreatePrimaryKey: Boolean;
+  end;
+
+  TSQLType = (stAlter, stCreate, stReCreate);
+
+  TUpdateEventType = (uetAddFields, uetKeys, uetAfterUpdate);
+
+  TUpdateEvent = procedure (ATableName: string; AEventType: TUpdateEventType;
+    ASQLType: TSQLType; AConnection: TADOConnection);
+
+  TScUpdater = class(TObject)
+  private
+    FTableDefList: TList;
+    FFileName: string;
+    FConnection: TADOConnection;
+    FFileVer: string;
+    FQuery: TADOQuery;
+    FForceUpdate: Boolean;
+    FForceCheck: Boolean;
+    FCurFileVersion: string;
+    FOnUpdateData: TUpdateEvent;
+    function GetCurFileVersion: string;
+    // 返回True:表存在,返回False: 表不存在
+    function CheckTable(ATableName: string): Boolean;
+    procedure GenerateSQL(ATableDef: PTableDef; ASQLType: TSQLType; ASQLList: TStrings);
+    procedure InternalExcuteSQL(ASQL: string; AHideException: Boolean = False; AOpen: Boolean = False);
+    function ExcuteUpdateSQL(ASQLList: TStrings): Boolean;
+    procedure SetForceUpdate(const Value: Boolean);
+    procedure SetForceCheck(const Value: Boolean);
+    procedure SetCurFileVersion(const Value: string);
+    // 字符串是否是事件
+    // 事件字符串格式:"事件名 表名 操作类型"
+    function CheckEvent(AText: string): Boolean;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    // 打开
+    procedure Open(AFileName: string; AConnection: TADOConnection;
+        AFileVer: string);
+    // 关闭
+    procedure Close;
+    // 执行升级操作
+    function ExcuteUpdate: Boolean;
+    // 执行其他SQL语句(如建立、删除索引)
+    procedure ExcuteSQL(ASQL: string);
+    // 添加表定义
+    function AddTableDef(ATableName: string; AFieldDefs: PFieldDefs; AFieldCount: Integer;
+        AReCreate, ARecreatePK: Boolean): Integer;
+    // 文件是否需要升级(根据版本号判断)
+    function FileNeedUpdate: Boolean;
+    // 强制进行表和字段的升级检查
+    property ForceCheck: Boolean read FForceCheck write SetForceCheck;
+    // 强制升级所有表和字段
+    property ForceUpdate: Boolean read FForceUpdate write SetForceUpdate;
+    // 最新文件版本
+    property CurrentFileVer: string read GetCurFileVersion write SetCurFileVersion;
+    // 事件
+    // 重建关键字之前
+    property OnUpdateData: TUpdateEvent read FOnUpdateData
+      write FOnUpdateData;
+  end;
+
+const
+  SQLTypeStrs: array [TSQLType] of string = ('Modify', 'Create', 'ReCreate');
+  SOnUpdateData = 'OnUpdateData';
+
+implementation
+
+uses
+  ConstMethodUnit, SysUtils;
+
+function StrToSQLType(ASQLType: string): TSQLType;
+var
+  I: TSQLType;
+begin
+  Result := stAlter;
+  for I := Low(SQLTypeStrs) to High(SQLTypeStrs) do
+  begin
+    if SameText(ASQLType, SQLTypeStrs[I]) then
+    begin
+      Result := I;
+      Break;
+    end;
+  end;
+end;
+
+{ TScUpdater }
+
+function TScUpdater.AddTableDef(ATableName: string; AFieldDefs: PFieldDefs;
+  AFieldCount: Integer; AReCreate, ARecreatePK: Boolean): Integer;
+var
+  pRec: PTableDef;
+begin
+  New(pRec);
+  pRec^.TableName := ATableName;
+  pRec^.FieldCount := AFieldCount;
+  pRec^.FieldDefs := AFieldDefs;
+  pRec^.Recreate := AReCreate;
+  pRec^.RecreatePrimaryKey := ARecreatePK;
+  Result := FTableDefList.Add(pRec);
+end;
+
+function TScUpdater.CheckEvent(AText: string): Boolean;
+var
+  strText, strEvent, strTableName, strEventType, strSQLType: string;
+  SQLType: TSQLType;
+  iPos: Integer;
+begin
+  Result := False;
+  strText := AText;
+  // 检查事件名称
+  iPos := Pos(' ', strText);
+  if iPos > 0 then
+  begin
+    strEvent := Copy(strText, 1, iPos - 1);
+    Delete(strText, 1, iPos);
+    if SameText(strEvent, SOnUpdateData) then
+    begin
+      // 事件类型
+      iPos := Pos(' ', strText);
+      strEventType := Copy(strText, 1, iPos - 1);
+      Delete(strText, 1, iPos);
+      // 表名
+      iPos := Pos(' ', strText);
+      strTableName := Copy(strText, 1, iPos - 1);
+      Delete(strText, 1, iPos);
+      // 操作类型
+      strSQLType := strText;
+      SQLType := StrToSQLType(strSQLType);
+
+      Result := True;
+      if Assigned(FOnUpdateData) then
+        FOnUpdateData(strTableName, TUpdateEventType(StrToInt(strEventType)), SQLType, FConnection);
+    end;
+  end;
+end;
+
+function TScUpdater.CheckTable(ATableName: string): Boolean;
+var
+  I: Integer;
+  Names: TStringList;
+begin
+  Names := TStringList.Create;
+  try
+    FConnection.GetTableNames(Names);
+    if Names.IndexOf(ATableName) < 0 then
+      Result := False
+    else
+      Result := True;
+  finally
+    Names.Free;
+  end;
+end;
+
+procedure TScUpdater.Close;
+begin
+  FQuery.Close;
+end;
+
+constructor TScUpdater.Create;
+begin
+  FForceUpdate := False;
+  FForceCheck := False;
+  FTableDefList := TList.Create;
+  FQuery := TADOQuery.Create(nil);
+end;
+
+destructor TScUpdater.Destroy;
+begin
+  Close;
+  FQuery.Free;
+  ClearPointerList(FTableDefList);
+  FTableDefList.Free;
+  inherited;
+end;
+
+procedure TScUpdater.ExcuteSQL(ASQL: string);
+begin
+  InternalExcuteSQL(ASQL);
+end;
+
+function TScUpdater.ExcuteUpdate: Boolean;
+var
+  I: Integer;
+  pRec: PTableDef;
+  SQLs: TStringList;
+  SQLType: TSQLType;
+  bHasError: Boolean;
+  sError: string;
+begin
+  Result := False;
+  bHasError := False;
+  sError := '';
+  if FileNeedUpdate then
+  begin
+    SQLs := TStringList.Create;
+    try
+      for I := 0 to FTableDefList.Count - 1 do
+      begin
+        pRec := PTableDef(FTableDefList[I]);
+        if CheckTable(pRec^.TableName) then
+        begin
+          if pRec^.Recreate then
+            SQLType := stReCreate
+          else
+            SQLType := stAlter;
+        end
+        else
+          SQLType := stCreate;
+        GenerateSQL(pRec, SQLType, SQLs);
+        if SQLs.Count > 0 then
+          if not ExcuteUpdateSQL(SQLs) then
+          begin
+            bHasError := True;
+            sError := sError + #13#10 + Format('Update operation [%s] on table [%s] can not excute!', [SQLTypeStrs[SQLType], pRec^.TableName]);
+          end;
+      end;
+    finally
+      SQLs.Free;
+    end;
+
+    if bHasError then
+      MessageWarning(0, '升级文件时发生错误,无法完成升级。'#13#10'错误信息:' + sError)
+    else
+      Result := True;
+  end;
+end;
+
+function TScUpdater.ExcuteUpdateSQL(ASQLList: TStrings): Boolean;
+var
+  I: Integer;
+  HideExcption: Boolean;
+begin
+  Result := False;
+  try
+    for I := 0 to ASQLList.Count - 1 do
+    begin
+      if not CheckEvent(ASQLList[I]) then
+      begin
+        HideExcption := ASQLList.Objects[I] <> nil;
+        if HideExcption then
+          HideExcption := Boolean(Integer(ASQLList.Objects[I]));
+        InternalExcuteSQL(ASQLList[I], HideExcption);
+      end;
+    end;
+    Result := True;
+  except
+
+  end;
+end;
+
+function TScUpdater.FileNeedUpdate: Boolean;
+begin
+  Result := (ScCompareFileVer(FFileVer, GetCurFileVersion) <> 0) or FForceCheck;
+end;
+
+function SameFieldType(AFieldType: TFieldType; AScFieldType: TScMDBFieldType): Boolean;
+begin
+  Result := False;
+  case AScFieldType of
+    ftString:
+      Result := (AFieldType = DB.ftWideString) or (AFieldType = DB.ftString);
+    ftByte:
+      Result := AFieldType = DB.ftWord;
+    ftSmallint:
+      Result := AFieldType = DB.ftSmallint;
+    ftInteger:
+      Result := AFieldType = DB.ftInteger;
+    ftBoolean:
+      Result := AFieldType = DB.ftBoolean;
+    ftSingle:
+      Result := AFieldType = DB.ftFloat;
+    ftDouble:
+      Result := AFieldType = DB.ftFloat;
+    ftCurrency:
+      Result := (AFieldType = DB.ftCurrency) or (AFieldType = DB.ftBCD);
+    ftDateTime:
+      Result := AFieldType = DB.ftDateTime;
+    ftMemo:
+      Result := AFieldType = DB.ftMemo;
+    ftOLEObject:
+      Result := AFieldType = DB.ftBlob;
+  end;
+end;
+
+procedure TScUpdater.GenerateSQL(ATableDef: PTableDef; ASQLType: TSQLType; ASQLList: TStrings);
+
+  function GenerateCreateSQL: string;
+  var
+    I: Integer;
+    Def: TScFieldDef;
+    strField, strFields, strKeyFields: string;
+  begin
+    Result := '';
+    if ATableDef^.FieldCount > 0 then
+    begin
+      // CREATE TABLE table1
+      Result := Format('CREATE TABLE %s ', [ATableDef^.TableName]);
+      strFields := '';
+      strKeyFields := '';
+      for I := 0 to ATableDef^.FieldCount - 1 do
+      begin
+        Def := ATableDef^.FieldDefs[I];
+        // field1 type
+        strField := Def.FieldName + ' ' + ScMDBFieldTypeName[Def.FieldType];
+
+        if Def.FieldType in [ftString] then
+          // field1 type (size)
+          strField := strField + ' ' + Format('(%d)', [Def.Size]);
+        if Def.NotNull then
+          // field1 type (size) NOT NULL
+          strField := strField + ' ' + 'NOT NULL';
+        if Def.PrimaryKey then
+          strKeyFields := strKeyFields + Def.FieldName + ', ';
+
+        strFields := strFields + strField + ', ';
+      end;
+      if strKeyFields <> '' then
+      begin
+        Delete(strKeyFields, Length(strKeyFields) - 1, 2);
+        // CONSTRAINT PrimaryKey PRIMARY KEY (field1, field2...)
+        strKeyFields := Format('CONSTRAINT %s PRIMARY KEY (%s)', [PrimaryKey, strKeyFields]);
+      end
+      else
+        Delete(strFields, Length(strFields) - 1, 2);
+      // (field1 type (size) NOT NULL, field2 type (size) NOT NULL..., CONSTRAINT PrimaryKey PRIMARY KEY (field1, field2...))
+      strFields := Format('(%s)', [strFields + strKeyFields]);
+      // CREATE TABLE table1 (field1 type (size) NOT NULL, field2 type (size) NOT NULL..., CONSTRAINT PrimaryKey PRIMARY KEY (field1, field2...))
+      Result := Result + strFields;
+    end;
+  end;
+
+type
+  TAlterType = (atAddField, atAlterField, atDropField, atAddIndex, atDropIndex);
+
+  function GenerateSingleFieldAlterSQL(ATableName: string; AFieldDef: TScFieldDef;
+    AOp: TAlterType; var ANeedDefault: Boolean): string;
+  begin
+    Result := '';
+    ANeedDefault := False;
+    case AOp of
+      atAddField:
+      begin
+        Result := Format('ALTER TABLE %s ADD COLUMN %s %s',
+            [ATableName, AFieldDef.FieldName, ScMDBFieldTypeName[AFieldDef.FieldType]]);
+        if AFieldDef.FieldType in [ftString] then
+          Result := Result + Format(' (%d)', [AFieldDef.Size]);
+        if AFieldDef.NotNull then
+        begin
+          Result := Result + ' NOT NULL';
+          case AFieldDef.FieldType of
+            ftByte, ftSmallint, ftInteger, ftBoolean, ftSingle, ftDouble,
+                 ftCurrency, ftDateTime:
+            ANeedDefault := True;
+          end;
+        end;
+      end;
+      atDropField:
+      begin
+        Result := Format('ALTER TABLE %s DROP COLUMN %s', [ATableName, AFieldDef.FieldName]);
+      end;
+      atAlterField:
+      begin
+        Result := Format('ALTER TABLE %s ALTER COLUMN %s %s',
+            [ATableName, AFieldDef.FieldName, ScMDBFieldTypeName[AFieldDef.FieldType]]);
+        if AFieldDef.FieldType in [ftString] then
+          Result := Result + Format(' (%d)', [AFieldDef.Size]);
+        if AFieldDef.NotNull then
+        begin
+          Result := Result + ' NOT NULL';
+          case AFieldDef.FieldType of
+            ftByte, ftSmallint, ftInteger, ftBoolean, ftSingle, ftDouble,
+                 ftCurrency, ftDateTime:
+            ANeedDefault := True;
+          end;
+        end;
+      end;
+    end;
+  end;
+
+  function GenerateDefaultValueSQL(ATableName: string; AFieldDef: TScFieldDef): string;
+  begin
+    Result := '';
+    case AFieldDef.FieldType of
+      ftByte, ftSmallint, ftInteger:
+        Result := Format('UPDATE  %s SET %s = %d',
+            [ATableName, AFieldDef.FieldName, 0]);
+      ftSingle, ftDouble, ftCurrency:
+        Result := Format('UPDATE  %s SET %s = %f',
+            [ATableName, AFieldDef.FieldName, 0.0]);
+      ftBoolean:
+        Result := Format('UPDATE  %s SET %s = %s',
+            [ATableName, AFieldDef.FieldName, 'FALSE']);
+      ftDateTime:
+        Result := Format('UPDATE  %s SET %s = ''%s''',
+            [ATableName, AFieldDef.FieldName, '2000-1-1 12:00:00']);
+    end;
+  end;
+
+  function GenerateSingleKeyAlterSQL(ATableName, AIndexName, AFieldNames: string; AOp: TAlterType): string;
+  begin
+    Result := '';
+    case AOp of
+      atAddIndex:
+      begin
+        Result := Format('ALTER TABLE %s ADD CONSTRAINT %s Primary Key (%s)', [ATableName, AIndexName, AFieldNames]);
+      end;
+      atDropIndex:
+      begin
+        Result := Format('ALTER TABLE %s DROP CONSTRAINT %s', [ATableName, AIndexName]);
+      end;
+    end;
+  end;
+
+  procedure GenerateAlterSQL;
+  var
+    I, J: Integer;
+    Field: TField;
+    pDef: PScFieldDef;
+    AddList, ModifyList: TList;
+    KeyFields: string;
+    bNeedDefaultValue: Boolean;
+  begin
+    InternalExcuteSQL(Format('SELECT * FROM %s WHERE 0=1', [ATableDef^.TableName]), False, True);
+
+    AddList := TList.Create;
+    ModifyList := TList.Create;
+    try
+      KeyFields := '';
+      for I := 0 to ATableDef^.FieldCount - 1 do
+      begin
+        pDef := @ATableDef^.FieldDefs^[I];
+        if (KeyFields <> '') and pDef^.PrimaryKey then
+          KeyFields := KeyFields + ', ';
+        if pDef^.PrimaryKey then
+          KeyFields := KeyFields + pDef^.FieldName;
+        AddList.Add(pDef);
+      end;
+
+{      if KeyFields <> '' then
+        Delete(KeyFields, Length(KeyFields) - 1, 2);}
+
+      for I := 0 to FQuery.Fields.Count - 1 do
+      begin
+        Field := FQuery.Fields[I];
+        for J := 0 to AddList.Count - 1 do
+        begin
+          pDef := PScFieldDef(AddList[J]);
+          if SameText(Field.FieldName, pDef^.FieldName) then
+          begin
+            if FForceUpdate then
+              ModifyList.Add(pDef)
+            else
+            begin
+              if not SameFieldType(Field.DataType, pDef^.FieldType) then
+                ModifyList.Add(pDef)
+              else if (Field.DataType in [ftWideString]) and (Field.Size <> pDef^.Size) then
+                ModifyList.Add(pDef);
+            end;
+            AddList.Remove(pDef);
+            Break;
+          end;
+        end;
+      end;
+
+      for I := 0 to ModifyList.Count - 1 do
+      begin
+        pDef := PScFieldDef(ModifyList[I]);
+        ASQLList.Add(GenerateSingleFieldAlterSQL(ATableDef^.TableName, pDef^, atAlterField, bNeedDefaultValue));
+        if bNeedDefaultValue then
+          ASQLList.Add(GenerateDefaultValueSQL(ATableDef^.TableName, pDef^));
+      end;
+
+      for I := 0 to AddList.Count - 1 do
+      begin
+        pDef := PScFieldDef(AddList[I]);
+        ASQLList.Add(GenerateSingleFieldAlterSQL(ATableDef^.TableName, pDef^, atAddField, bNeedDefaultValue));
+        if bNeedDefaultValue then
+          ASQLList.Add(GenerateDefaultValueSQL(ATableDef^.TableName, pDef^));
+      end;
+      if AddList.Count > 0 then
+        // 添加事件
+        ASQLList.Add(Format('%s %d %s %s', [SOnUpdateData, Ord(uetAddFields), ATableDef.TableName, SQLTypeStrs[ASQLType]]));
+
+
+      if ATableDef.RecreatePrimaryKey then
+      begin
+        ASQLList.AddObject(GenerateSingleKeyAlterSQL(ATableDef^.TableName, PrimaryKey, KeyFields, atDropIndex), TObject(Integer(True)));
+        // 添加事件
+        ASQLList.Add(Format('%s %d %s %s', [SOnUpdateData, Ord(uetKeys), ATableDef.TableName, SQLTypeStrs[ASQLType]]));
+        ASQLList.Add(GenerateSingleKeyAlterSQL(ATableDef^.TableName, PrimaryKey, KeyFields, atAddIndex));
+      end;
+    finally
+      AddList.Free;
+      ModifyList.Free;
+    end;
+  end;
+
+begin
+  ASQLList.Clear;
+  case ASQLType of
+    stAlter:
+      GenerateAlterSQL;
+    stCreate:
+      ASQLList.Add(GenerateCreateSQL);
+    stReCreate:
+    begin
+      ASQLList.Add(Format('DROP TABLE %s', [ATableDef^.TableName]));
+      ASQLList.Add(GenerateCreateSQL);
+    end;
+  end;
+  if ASQLList.Count > 0 then
+   ASQLList.Add(Format('%s %d %s %s', [SOnUpdateData, Ord(uetAfterUpdate), ATableDef^.TableName, SQLTypeStrs[ASQLType]]));
+end;
+
+function TScUpdater.GetCurFileVersion: string;
+begin
+  if FCurFileVersion <> '' then
+    Result := FCurFileVersion
+  else
+  begin
+    Result := ConstBillsFileVersion;
+    {$IFDEF _ScBills}
+    Result := ConstBillsFileVersion;
+    {$ENDIF}
+    {$IFDEF _ScBudget}
+      {$IFDEF _ScEstimate}
+      Result := ConstEstimateFileVersion;
+      {$ELSE}
+      Result := ConstBudgetFileVersion;
+      {$ENDIF}
+    {$ENDIF}
+    {$IFDEF _ScRation}
+    Result := ConstRationLibFileVersion;
+    {$ENDIF}
+  end;
+end;
+
+procedure TScUpdater.InternalExcuteSQL(ASQL: string; AHideException, AOpen: Boolean);
+begin
+  FQuery.Close;
+  FQuery.SQL.Clear;
+  FQuery.SQL.Add(ASQL);
+  try
+    if AOpen then
+      FQuery.Open
+    else
+      FQuery.ExecSQL;
+  except
+    if not AHideException then
+      raise;
+  end;
+end;
+
+procedure TScUpdater.Open(AFileName: string; AConnection: TADOConnection;
+  AFileVer: string);
+begin
+  FFileName := AFileName;
+  FConnection := AConnection;
+  FFileVer := AFileVer;
+  if AFileVer = '' then
+    FFileVer := '0.0.0.0';
+  FQuery.Connection := AConnection;
+  ClearPointerList(FTableDefList);
+end;
+
+procedure TScUpdater.SetCurFileVersion(const Value: string);
+begin
+  FCurFileVersion := Value;
+end;
+
+procedure TScUpdater.SetForceCheck(const Value: Boolean);
+begin
+  FForceCheck := Value;
+end;
+
+procedure TScUpdater.SetForceUpdate(const Value: Boolean);
+begin
+  FForceUpdate := Value;
+end;
+
+end.

+ 820 - 0
CU/ScBillsTree.pas

@@ -0,0 +1,820 @@
+unit ScBillsTree;
+
+interface
+
+uses
+  ZjIDTree, Classes, DB, ConstMethodUnit,
+  ConstVarUnit, ConstTypeUnit, DBClient;
+
+const
+  idFirstSection = 1;
+  idSecondSection = 2;
+  idThreeSection = 3;
+  // 第一二三部分费用合计
+  idAggregate123 = 4;
+  idPricePerKM = 8;
+  // 概(预)算总金额
+  idBugetTotalPrice = 5;
+  // 公路基本造价
+  idProjectTotalPrice = 6;  
+
+type
+  {BillsTree}
+
+  TScBillsItem = class(TZjIDTreeNode)
+  private
+    FSCode: string;
+    FSBCode: string;
+    FSName: string;
+    // 是否是预定义项,即系统预设的项目,而不是用户输入的,且不允许删除
+    FIsPreDefine: Boolean;
+    FSelected: Boolean;
+    FBills: TObject;
+
+    FUnits: string;
+    FQuantity: Double;  // 需要用到Null值
+    FDesignQuantity: Double;
+    FDesignQuantity2: Double;
+    FIsRepeat: Boolean;    // 是否是重复行
+    FIsSuperscale: Boolean;
+    FUserModified: Boolean;
+    FErrorHint: string;
+    FDeductGrade: Currency;
+    FLostPreSiblingCount: Integer;
+    FLostChildrenCount: Integer;
+    FStandardGrade: Currency;
+    FLostNextSiblingCount: Integer;
+    FIsIgNore: Boolean;
+    FNameErrorFlag: Integer;
+    FUnitsErrorFlag: Integer;
+    FRightName: String;
+    FRightUnits: String;
+    FIsAccQuantity: Boolean;
+
+    function GetLastBudgetParent: TScBillsItem;
+    function GetBillCategory: TBillCategory;
+    function GetNeed: Boolean;
+
+
+    function GetTotalPrice(AIsTender: Boolean): Currency;
+    function GetChapterID: Integer;
+    function GetCode: string;
+    procedure SetSelected(const Value: Boolean);
+  public
+    constructor Create(AOwner: TZjIDTree); override;
+    function CanUpLevel: Boolean; override;
+    function CanDownLevel: Boolean; override;
+    function CanUpMove: Boolean; override;
+    function CanDownMove: Boolean; override;
+
+    function HasDrawingQuantity: Boolean;
+    procedure SyncSelected(aValue: Boolean);
+
+    function IsInheritFrom(AID: Integer): Boolean;
+
+    property Bills: TObject read FBills write FBills;
+    property IsPreDefine: Boolean read FIsPreDefine;
+    property ChapterID: Integer read GetChapterID;
+//    property Code: string read GetCode;
+    property TotalPrice[AIsTender: Boolean]: Currency read GetTotalPrice;
+    property Selected: Boolean read FSelected write SetSelected;
+
+    property SBillCode: string read FSCode write FSCode;
+    property SBillBCode: string read FSBCode write FSBCode;
+    property SBillName: string read FSName write FSName;
+
+    property Code: string read FSCode write FSCode;
+    property B_Code: string read FSBCode write FSBCode;
+    property Name: string read FSName write FSName;
+    property Units: string read FUnits write FUnits;
+    property Quantity: Double read FQuantity write FQuantity;
+    property DesignQuantity: Double read FDesignQuantity write FDesignQuantity;
+    property DesignQuantity2: Double read FDesignQuantity2 write FDesignQuantity2;
+    property UserModified: Boolean read FUserModified write FUserModified;
+    property ErrorHint: string read FErrorHint write FErrorHint;
+    property DeductGrade: Currency read FDeductGrade write FDeductGrade;
+    property IsSuperscale: Boolean read FIsSuperscale write FIsSuperscale;
+    property LostPreSiblingCount: Integer read FLostPreSiblingCount write FLostPreSiblingCount;
+    property LostChildrenCount: Integer read FLostChildrenCount write FLostChildrenCount;
+    property LostNextSiblingCount: Integer read FLostNextSiblingCount write FLostNextSiblingCount;
+    property StandardGrade: Currency read FStandardGrade write FStandardGrade;
+    property IsIgNore: Boolean read FIsIgNore write FIsIgNore;
+    property NameErrorFlag: Integer read FNameErrorFlag write FNameErrorFlag;
+    property UnitsErrorFlag: Integer read FUnitsErrorFlag write FUnitsErrorFlag;
+    property RightName: string read FRightName write FRightName;
+    property RightUnits: string read FRightUnits write FRightUnits;
+    
+    property LastBudgetParent: TScBillsItem read GetLastBudgetParent;
+    property Category: TBillCategory read GetBillCategory;
+    property IsRepeat: Boolean read FIsRepeat write FIsRepeat;
+    property NeedSearchInStdLib: Boolean read GetNeed;
+
+    // Modified By MaiXinRong 2012-03-21 是否填父项量
+    property IsAccQuantity: Boolean read FIsAccQuantity write FIsAccQuantity;
+  end;
+
+  TScBillsTree = class(TZjIDTree)
+  private
+    FBills: TObject;
+    FShowError: Boolean;
+    FInternalEvent: TInternalEvent;
+    function GetBillsItem(ID: Integer): TScBillsItem;
+    function GetItems(AIndex: Integer): TScBillsItem;
+  protected
+    function CreateItem: TScIDTreeNode; override;
+    procedure LoadItem(AItem: TScIDTreeNode); override;
+    procedure InitDBRecord; override;
+  public
+    function AddBillsItem(AParentID, ANextSiblingID: TScTreeNodeID): TScBillsItem; overload;
+    function AddBillsItem(AID, AParentID, ANextSiblingID: TScTreeNodeID): TScBillsItem; overload;
+    function Add(AParentID, ANextSiblingID: TScTreeNodeID): TScIDTreeNode; override;
+    function CanAdd(AParentID, ANextSiblingID: TScTreeNodeID): Boolean; override;
+    function CanDelete(ANode: TScIDTreeNode): Boolean; override;
+    function DeleteNode(ANode: TScIDTreeNode): Boolean; override;
+    property BillsItem[ID: Integer]: TScBillsItem read GetBillsItem; default;
+    property Items[AIndex: Integer]: TScBillsItem read GetItems;
+    property Bills: TObject read FBills write FBills;
+    property ShowError: Boolean read FShowError write FShowError;
+    {Events}
+    property InternalEvent: TInternalEvent read FInternalEvent write FInternalEvent;
+    function FindNode(AID: TZjTreeNodeID): TScBillsItem;
+
+  end;
+
+
+  {stdBillsTree}
+
+  TStdBillNode = class (TZjIDTreeNode)
+  private
+    FCode: string;
+    FBCode: string;
+    FName: string;
+    FUnits: string;
+    FNotes: string;
+    FFee: string;
+    FStaticID: Integer;
+    FExpr: string;
+    FGradeType: Integer;
+    function GetStringValue(AIdx: Integer): string;
+    procedure SetStringValue(AIdx: Integer; Value: string);
+    function GetLastBudgetParent: TStdBillNode;
+    function GetHasYsxmjChild: Boolean;
+  public
+
+    function TopestAncestor(AList: TList): TStdBillNode;
+    property Code: string index 0 read GetStringValue write SetStringValue;
+    property BCode: string index 1 read GetStringValue write SetStringValue;
+    property Name: string index 2 read GetStringValue write SetStringValue;
+    property Units: string index 3 read GetStringValue write SetStringValue;
+    property Notes: string index 4 read GetStringValue write SetStringValue;
+    property Fee: string index 5 read GetStringValue write SetStringValue;
+    property Exprs: string index 6 read GetStringValue write SetStringValue;
+    property GradeType: Integer read FGradeType write FGradeType;
+    property StaticID: Integer read FStaticID write FStaticID;
+    property LastBudgetParent: TStdBillNode read GetLastBudgetParent;
+    property HasYsxmjChild: Boolean read GetHasYsxmjChild;
+  end;
+
+  TStdBillsTree = class (TZjIDTree)
+  protected
+    function CreateItem: TScIDTreeNode; override;
+    procedure LoadItem(AItem: TScIDTreeNode); override;
+  public
+{-------------------------------------------------------------------------------
+  方法:  FindNode
+  描述:  ABItem:要查找的最终清单
+         ALostBItem:没有找到的那一层清单
+         ALostStdPaItem:ALostBItem在标准项目表中对应的标准项的父标准项。
+         它的父标准项一定存在于标准项目表(即ALostStdPaItem一定存在)。
+         当某清单搜不到时立即返回该清单,不再往下搜索。
+         如:搜索1-1/1-1-2/1-1-2-9/301-1/301-1-5,在1-1-2-9时出错了,则:
+         ABItem: 301-1-5  ALostBItem: 1-1-2-9 ALostStdPaItem: 1-1-2
+
+  作者:  Chenshilong, 2010-12-15 17:48:38
+-------------------------------------------------------------------------------}
+    function FindNode(ABItem: TScBillsItem; var ALostBItem: TScBillsItem;
+      var ALostStdPaItem: TStdBillNode): TStdBillNode; overload;
+    function FindNode(ACode, AB_Code: string): TStdBillNode; overload;
+  end;
+
+  { XMJ }
+
+  TXMJBillsItem = class(TScBillsItem)
+  public
+    function CanUpLevel: Boolean; override;
+    function CanDownLevel: Boolean; override;
+  end;
+
+  TXMJBillsTree = class(TScBillsTree)
+  protected
+    function CreateItem: TScIDTreeNode; override;
+  end;
+
+  { Merge }
+
+  TAdditionalItem = class(TZjIDTreeNode)
+  private
+    FCode: string;
+    FB_Code: string;
+    FName: string;
+    FUnits: string;
+    FOwnerName: string;
+    FMemoStr: string;
+
+    FQuantity: Double;
+    FQuantity2: Double;
+
+    FUnitPrice: Currency;
+    FTotalPrice: Currency;
+    FDesignQuantity: Currency;
+    FDesignQuantity2: Currency;
+    FDesignPrice: Currency;
+  public
+    property Code: string read FCode write FCode;
+    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 MemoStr: string read FMemoStr write FMemoStr;
+    property OwnerName: string read FOwnerName write FOwnerName;
+    property Quantity: Double read FQuantity write FQuantity;
+    property Quantity2: Double read FQuantity2 write FQuantity2;
+    property UnitPrice: Currency read FUnitPrice write FUnitPrice;
+    property TotalPrice: Currency read FTotalPrice write FTotalPrice;
+    property DesignQuantity: Currency read FDesignQuantity write FDesignQuantity;
+    property DesignQuantity2: Currency read FDesignQuantity2 write FDesignQuantity2;
+    property DesignPrice: Currency read FDesignPrice write FDesignPrice;
+  end;
+
+  TAdditinalTree = class(TScBillsTree)
+  protected
+    function CreateItem: TScIDTreeNode; override;
+    procedure LoadItem(AItem: TScIDTreeNode); override;
+    procedure InitDBRecord; override;
+
+  end;
+
+implementation
+
+uses DataBase, SysUtils, Variants;
+
+{ TScBillsItem }
+
+function TScBillsItem.CanDownLevel: Boolean;
+begin
+  Result := inherited CanDownLevel
+//    and not TDMDataBase(Bills).HasDrawingQuantity(PrevSiblingID)
+    and not IsPreDefine;      // 不是预定义项
+end;
+
+function TScBillsItem.CanDownMove: Boolean;
+begin
+  Result := inherited CanDownMove and not IsPreDefine;
+end;
+
+function TScBillsItem.CanUpLevel: Boolean;
+begin
+  Result := not IsPreDefine
+        and ((Level > 1) or not IsInheritFrom(idFirstSection)) // 第一部分的项目Level必须大于1才能升级,其它部分不限制 
+        and inherited CanUpLevel;
+        {and (
+           { (NextSibling = nil)
+              or (
+                 (HasChildren and not HasDrawingQuantity)
+                 )
+            );      }
+
+        // 说明: 当该项目不是预定义项,Levle>1并且满足一下条件时可以升级
+        { 1: 没有后续兄弟节点的时候,可以升级
+          2: 有后续兄弟节点时,必须没有定额和自定义的金额(即:用户直接输入金额或计算式),
+             判断没有自定义金额的方法是: TotalPrice = 0 并且 没有子项。
+        }
+
+{  if not Result and TScBillsTree(Owner).FShowError then
+  begin
+    if HasDrawingQuantity then
+      MessageWarning(0, '该项目下面有图纸工程量,不能升级');
+  end;   }
+end;
+
+function TScBillsItem.CanUpMove: Boolean;
+begin
+  Result := inherited CanUpMove and not IsPreDefine;
+end;
+
+constructor TScBillsItem.Create(AOwner: TZjIDTree);
+begin
+  inherited Create(AOwner);
+//  FSelected := False;
+  Bills := TScBillsTree(AOwner).Bills;
+end;
+
+function TScBillsItem.GetBillCategory: TBillCategory;
+begin
+  Result := BillCategory(FSCode, FSBCode);
+end;
+
+function TScBillsItem.GetChapterID: Integer;
+var
+  Node: TScIDTreeNode;
+begin
+  Node := Self;
+
+  while Node.Parent <> nil do
+  begin
+     if Node.Parent.ID in [idFirstSection, idSecondSection, idThreeSection] then
+     begin
+       Result := Node.ID;
+       Exit;
+     end;
+     Node := Node.Parent;
+  end;
+  Result := ID;
+end;
+
+function TScBillsItem.GetCode: string;
+begin
+  Result := VarToStr(Owner.DataSet.Lookup(SID, ID, sCode));
+end;
+
+function TScBillsItem.GetLastBudgetParent: TScBillsItem;
+var vItem: TScBillsItem;
+begin
+  Result := nil;
+
+  vItem := Self;
+  while Assigned(vItem) do
+  begin
+    vItem := TScBillsItem(vItem.Parent);
+
+    if (Trim(vItem.Code) <> '') and (Trim(vItem.B_Code) = '') then
+    begin
+      Result := vItem;
+      Break;
+    end;
+  end;
+end;
+
+
+function TScBillsItem.GetNeed: Boolean;
+begin
+  Result := not (IsRepeat or IsSuperscale);
+end;
+
+function TScBillsItem.GetTotalPrice(AIsTender: Boolean): Currency;
+const
+  sResult: array[Boolean] of string = (STotalPrice, STenderTotalPrice);
+begin
+  Result := ScVarToCurrency(TDMDataBase(Bills).cdsBills.Lookup(SID, ID, sResult[AIsTender]));
+end;
+
+function TScBillsItem.HasDrawingQuantity: Boolean;
+begin
+  Result := TDMDataBase(Bills).HasDrawingQuantity(ID);
+end;
+
+function TScBillsItem.IsInheritFrom(AID: Integer): Boolean;
+var
+  vAncestor: TScBillsItem;
+  vItem: TScBillsItem;
+begin
+  Result := False;
+  vAncestor := TScBillsTree(Owner).BillsItem[AID];
+  if vAncestor = nil then Exit;
+  
+  vItem := Self;
+  while (vItem <> nil) and (vItem <> vAncestor) do
+    vItem := TScBillsItem(vItem.Parent);
+  Result := vItem = vAncestor;
+end;
+
+procedure TScBillsItem.SetSelected(const Value: Boolean);
+begin
+  FSelected := Value;
+  TDMDataBase(Bills).ModifySelected(ID, FSelected);
+end;
+
+procedure TScBillsItem.SyncSelected(aValue: Boolean);
+begin
+  FSelected := aValue;
+end;
+
+{ TScBillsTree }
+
+function TScBillsTree.Add(AParentID,
+  ANextSiblingID: TScTreeNodeID): TScIDTreeNode;
+begin
+  FShowError := True;
+  try
+    if (Selected <> nil) and (Selected.Level = 0) then
+    begin
+      if (Selected.ID in [idAggregate123, idBugetTotalPrice, idPricePerKM]) then
+        Result := inherited Add(Selected.ParentID, Selected.NextSiblingID)
+      else
+        Result := inherited Add(Selected.ID, -1);
+    end
+    else
+      Result := inherited Add(AParentID, ANextSiblingID);
+  finally
+    FShowError := False;
+  end; 
+end;
+
+function TScBillsTree.AddBillsItem(AParentID,
+  ANextSiblingID: TScTreeNodeID): TScBillsItem;
+begin
+  Result := TScBillsItem(Add(AParentID, ANextSiblingID));
+end;
+
+function TScBillsTree.AddBillsItem(AID, AParentID,
+  ANextSiblingID: TScTreeNodeID): TScBillsItem;
+begin
+  if not (Assigned(DataSet) and DataSet.Active){Active} then
+    raise Exception.Create('无法在一个关闭的数据集上执行该操作');
+  Result := nil;
+  if CanAdd(AParentID, ANextSiblingID) then
+  begin
+    DataSet.Insert;
+    ParentField.AsInteger := AParentID;
+    NextSiblingField.AsInteger := ANextSiblingID;
+    InitDBRecord;
+    KeyField.AsInteger := AID;
+    DataSet.Post;
+    Result := TScBillsItem(inherited Add(KeyField.AsInteger, AParentID, ANextSiblingID));
+  end;
+end;
+
+function TScBillsTree.CanAdd(AParentID,
+  ANextSiblingID: TScTreeNodeID): Boolean;
+var
+  ParentNode: TScBillsItem;  
+begin
+  ParentNode := BillsItem[AParentID];
+
+  Result :=
+    (ParentNode = nil)
+    or not ParentNode.IsPreDefine
+    or not(AParentID in [idAggregate123, idBugetTotalPrice, idProjectTotalPrice,
+        idPricePerKM]);
+
+  if not Result and FShowError then
+    MessageWarning(0, ' 该项目下面不能添加子项  ');
+
+  if ParentNode = nil then Exit;
+
+ { if Result then
+  begin
+    Result := not TDMDataBase(Bills).HasDrawingQuantity(AParentID); 
+    if not Result and FShowError then
+      MessageWarning(0, ' 父项下面图纸工程量,如果要添加子项,请先删除该项目下面的图纸工程量');
+  end;       }
+
+  if Result then
+  begin
+    Result := (ParentNode.TotalPrice[False] = 0) or ParentNode.HasChildren; // 父项不能有用户直接输入的金额或计算公式
+    if not Result and FShowError then
+      MessageWarning(0, ' 父项有用户直接输入的金额或者计算公式,如果要添加子项,请先删除该项目的金额或计算公式 ');
+  end;
+end;
+
+function TScBillsTree.CanDelete(ANode: TScIDTreeNode): Boolean;
+var
+  IsPreDefine: Boolean;
+begin
+  Result := False;
+  if (ANode <> nil) and TDMDataBase(FBills).cdsBills.FindKey([ANode.ID]) then
+  begin
+    // 预定义项
+    IsPreDefine := TDMDataBase(FBills).cdsBills.FieldByName('IsPreDefine').AsBoolean;
+
+    if not IsPreDefine then  // IsPreDefine字段值为空或False
+    begin
+      Result := True;
+      if FShowError then
+      begin
+        // 固定ID清单项
+        if (not TDMDataBase(FBills).cdsOrgBillsIsPreDefine.Value) and (TDMDataBase(FBills).cdsBillsID.value < 100) then
+          Result := MessageQuest('提醒:清单[' + TDMDataBase(FBills).cdsBillsName.AsString +']是固定ID清单,删除后可以从右侧的清单范本中重新添加,'
+            + #10#13 + '添加后其ID值不变。但若通过手工录入的方式添加则不具有此功能。确认要继续吗?', '确认删除');
+
+        // 有子清单
+        if TScBillsItem(ANode).HasChildren then
+          Result := MessageQuest('确认要删除该清单项及其下面的所有子项吗?', '确认删除')
+        // 没有子清单,但有定额或数量单价类
+        else if TDMDataBase(FBills).HasDrawingQuantity(TScBillsItem(ANode).ID) then
+          Result := MessageQuest('该清单项下有图纸工程量,确认要删除该清单项吗?', '确认删除');
+      end;
+    end
+    // IsPreDefine字段值为True时不能删。
+    else if FShowError then
+      MessageWarning(0, '该项是预定义项,不能被删除 ');
+  end;
+end;
+
+function TScBillsTree.CreateItem: TScIDTreeNode;
+begin
+  Result := TScBillsItem.Create(Self);
+end;
+
+
+function TScBillsTree.DeleteNode(ANode: TScIDTreeNode): Boolean;
+begin
+  FShowError := True;
+  try
+    Result := inherited DeleteNode(ANode);
+  finally
+    FShowError := False;
+  end;
+end;
+
+function TScBillsTree.FindNode(AID: TZjTreeNodeID): TScBillsItem;
+begin
+  Result := TScBillsItem(inherited FindNode(AID));
+end;
+
+function TScBillsTree.GetBillsItem(ID: Integer): TScBillsItem;
+begin
+  Result := TScBillsItem(FindNode(ID));
+end;
+
+function TScBillsTree.GetItems(AIndex: Integer): TScBillsItem;
+begin
+  Result := TScBillsItem(inherited Items[AIndex]);
+end;
+
+procedure TScBillsTree.InitDBRecord;
+begin
+  if Assigned(FInternalEvent) then FInternalEvent;
+end;
+
+procedure TScBillsTree.LoadItem(AItem: TScIDTreeNode);
+begin
+  inherited;
+  with TScBillsItem(AItem) do
+  begin
+    FIsPreDefine := DataSet.FieldByName('IsPreDefine').AsBoolean;
+    FSCode := DataSet.FieldByName(sCode).AsString;
+    FSBCode := DataSet.FieldByName(sB_Code).AsString;
+    FSName := DataSet.FieldByName(sName).AsString;
+    FSelected := DataSet.FieldByName('Selected').AsBoolean;
+
+    FUnits := DataSet.FieldByName('Units').AsString;
+    FQuantity := DataSet.FieldByName('Quantity').AsFloat;
+    FDesignQuantity := DataSet.FieldByName('DesignQuantity').AsFloat;
+    FDesignQuantity2 := DataSet.FieldByName('DesignQuantity2').AsFloat;
+    FIsSuperscale := DataSet.FieldByName('IsSuperscale').AsBoolean;
+    FUserModified := DataSet.FieldByName('UserModified').AsBoolean;
+    FIsIgNore := DataSet.FieldByName('IsIgNore').AsBoolean;
+    FErrorHint := DataSet.FieldByName('ErrorHint').AsString;
+    FDeductGrade := DataSet.FieldByName('DeductGrade').AsCurrency;
+    FStandardGrade := DataSet.FieldByName('StandardGrade').AsCurrency;
+    FLostPreSiblingCount := DataSet.FieldByName('LostPreSiblingCount').AsInteger;
+    FLostChildrenCount := DataSet.FieldByName('LostChildrenCount').AsInteger;
+    FLostNextSiblingCount := DataSet.FieldByName('LostNextSiblingCount').AsInteger;
+    FNameErrorFlag := DataSet.FieldByName('NameErrorFlag').AsInteger;
+    FUnitsErrorFlag := DataSet.FieldByName('UnitsErrorFlag').AsInteger;
+    FRightName := DataSet.FieldByName('RightName').AsString;
+    FRightUnits := DataSet.FieldByName('RightUnits').AsString;
+
+    FIsAccQuantity := DataSet.FieldByName('IsAccQuantity').AsBoolean;
+  end;
+end;
+
+{ TStdBillNode }
+
+function TStdBillNode.GetHasYsxmjChild: Boolean;
+var i: Integer;
+  vItem: TStdBillNode;
+begin
+  Result := False;
+  for i := 0 to ChildCount - 1 do
+  begin
+    vItem := TStdBillNode(Self.ChildNodes[i]);
+    if vItem.Code <> '' then
+    begin
+      Result := True;
+      Break;
+    end;
+  end;
+end;
+
+function TStdBillNode.GetLastBudgetParent: TStdBillNode;
+var vNode: TStdBillNode;
+begin
+  Result := nil;
+
+  vNode := Self;
+  while Assigned(vNode) do
+  begin
+    vNode := TStdBillNode(vNode.Parent);
+
+    if (vNode.FCode <> '') and (vNode.FBCode = '') then
+    begin
+      Result := vNode;
+      Break;
+    end;
+  end;
+end;
+
+function TStdBillNode.GetStringValue(AIdx: Integer): string;
+begin
+  case AIdx of
+    0: Result := FCode;
+    1: Result := FBCode;
+    2: Result := FName;
+    3: Result := FUnits;
+    4: Result := FNotes;
+    5: Result := FFee;
+    6: Result := FExpr;
+  end;
+end;
+
+
+procedure TStdBillNode.SetStringValue(AIdx: Integer; Value: string);
+begin
+  case AIdx of
+    0: FCode := Value;
+    1: FBCode := Value;
+    2: FName := Value;
+    3: FUnits := Value;
+    4: FNotes := Value;
+    5: FFee := Value;
+    6: FExpr := Value;
+  end;
+end;
+
+function TStdBillNode.TopestAncestor(AList: TList): TStdBillNode;
+var
+  vNode: TZjIDTreeNode;
+begin
+  vNode := Self;
+  while Assigned(vNode.Parent) do
+  begin
+    AList.Add(vNode.Parent);
+    vNode := vNode.Parent;
+  end;
+  Result := TStdBillNode(vNode);
+end;
+
+{ TStdBillsTree }
+
+
+function TStdBillsTree.CreateItem: TScIDTreeNode;
+begin
+  Result := TStdBillNode.Create(Self);
+end;
+
+function TStdBillsTree.FindNode(ABItem: TScBillsItem; var ALostBItem: TScBillsItem;
+  var ALostStdPaItem: TStdBillNode): TStdBillNode;
+var BGPaList: TList;
+  vBPaItem: TScBillsItem;
+  vStdItem, vStdItemChild: TStdBillNode;
+  i, j: Integer;
+  bFinded: Boolean;
+
+  // 获取父结点列表,包括自身
+  procedure GetBGParents;
+  begin
+    vBPaItem := ABItem;
+    while Assigned(vBPaItem) do
+    begin
+      BGPaList.Add(vBPaItem);
+      vBPaItem := TScBillsItem(vBPaItem.Parent);
+    end;
+  end;
+begin
+  Result := nil;
+  // 从标准项目表第一结点开始(1 第一部分 建筑安装工程费)
+  vStdItem := TStdBillNode(Self.Items[0]);
+  if ABItem.ID = 1 then
+  begin
+    Result := vStdItem;
+    Exit;
+  end;
+
+  try
+    BGPaList := TList.Create;
+    GetBGParents;
+
+    // 从次顶层父结点开始(如1-1),逐层往下搜索
+    for i := BGPaList.Count - 2 downto 0 do
+    begin
+      vBPaItem := TScBillsItem(BGPaList[i]);
+      bFinded := False;
+
+      for j := 0 to vStdItem.ChildCount - 1 do
+      begin
+        vStdItemChild := TStdBillNode(vStdItem.ChildNodes[j]);
+        if (vBPaItem.Code = vStdItemChild.Code) and (vBPaItem.FSBCode = vStdItemChild.FBCode) then
+        begin
+          vStdItem := vStdItemChild;
+
+          if vBPaItem = ABItem then
+          begin
+            Result := vStdItem;
+            Exit;
+          end;
+
+          bFinded := True;
+          Break;
+        end;
+      end;
+
+      if not bFinded then
+      begin
+        ALostBItem := vBPaItem;
+        ALostStdPaItem := vStdItem;
+      end;
+    end;
+  finally
+    BGPaList.Free;
+  end;
+end;
+
+function TStdBillsTree.FindNode(ACode, AB_Code: string): TStdBillNode;
+var i: Integer;
+  vNode: TStdBillNode;
+begin
+  Result := nil;
+
+  for i := 0 to Count - 1 do
+  begin
+    vNode := TStdBillNode(Items[i]);
+    if SameText(vNode.Code, ACode) and SameText(vNode.BCode, AB_Code) then
+    begin
+      Result := vNode;
+      Break;
+    end;
+  end;
+end;
+
+procedure TStdBillsTree.LoadItem(AItem: TScIDTreeNode);
+begin
+  with TStdBillNode(AItem) do
+  begin
+    Code := DataSet.FieldByName('Code').AsString;
+    BCode := DataSet.FieldByName('B_Code').AsString;
+    Name := DataSet.FieldByName('Name').AsString;
+    Units := DataSet.FieldByName('Unit').AsString;
+    Exprs := DataSet.FieldByName('Expr').AsString;
+    if DataSet.FieldByName('StaticID').IsNull then
+      StaticID := -1
+    else
+      StaticID := DataSet.FieldByName('StaticID').AsInteger;
+  end;
+end;
+
+{ TXMJBillsItem }
+
+function TXMJBillsItem.CanDownLevel: Boolean;
+begin
+  Result := False;
+end;
+
+function TXMJBillsItem.CanUpLevel: Boolean;
+begin
+  Result := False;
+end;
+
+{ TXMJBillsTree }
+
+function TXMJBillsTree.CreateItem: TScIDTreeNode;
+begin
+  Result := TXMJBillsItem.Create(Self);
+end;
+
+{ TMergeTree }
+
+function TAdditinalTree.CreateItem: TScIDTreeNode;
+begin
+  Result := TAdditionalItem.Create(Self);
+end;
+
+procedure TAdditinalTree.InitDBRecord;
+begin
+
+end;
+
+procedure TAdditinalTree.LoadItem(AItem: TScIDTreeNode);
+begin
+  
+  with TAdditionalItem(AItem) do
+  begin
+    FCode            := DataSet.FieldByName(sCode).AsString;
+    FB_Code          := DataSet.FieldByName(sB_Code).AsString;
+    FName            := DataSet.FieldByName(sName).AsString;
+    FUnits           := DataSet.FieldByName(sUnits).AsString;
+    FMemoStr         := DataSet.FieldByName(sMemoStr).AsString;
+    FOwnerName       := DataSet.FieldByName(sOwnerName).AsString;
+
+    FQuantity        := DataSet.FieldByName(sQuantity).AsFloat;
+    FQuantity2       := DataSet.FieldByName(sQuantity2).AsFloat;
+
+    FUnitPrice       := DataSet.FieldByName(sUnitPrice).AsCurrency;
+    FTotalPrice      := DataSet.FieldByName(STotalPrice).AsCurrency;
+    FDesignQuantity  := DataSet.FieldByName(sDesignQuantity).AsCurrency;
+    FDesignQuantity2 := DataSet.FieldByName(sDesignQuantity2).AsCurrency;
+    FDesignPrice     := DataSet.FieldByName(sDesignPrice).AsCurrency;
+  end;
+end;
+
+end.

+ 223 - 0
CU/ScConfig.pas

@@ -0,0 +1,223 @@
+unit ScConfig;
+
+interface
+
+uses IniFiles, Classes, ConstVarUnit, SysUtils, ConstMethodUnit;
+
+type
+  TScConfigInfo = class(TObject)
+  private
+    FStrings               : TStrings;
+    {string}
+    FIniFileName           : string;
+    {boolean}
+    FAutoSaveProjects      : Boolean;
+    FAllowMfyCode          : Boolean;
+    FSaveAllProjects       : Boolean;
+    FSaveRestorePoint      : Boolean;
+    FAutoCollapse          : Boolean;
+    FRealTimeCalc          : Boolean;
+    FMatchCodeOnly         : Boolean;
+    {integer}
+    FAutoSaveInterval      : Integer;
+
+    FSearchURL: string;
+    FLoginURL: string;
+    FRegURL: string;
+    FCheckOnLineURL: string;
+    FLogoutURL: string;
+    FPwdURL: string;
+    FServerDateTimeURL: string;
+    FOldUserResetPwdURL: string;
+    FWebSoftURL: string;
+    FWebLoginURL: string;
+    FJumpURL: string;
+    FShowDrawingCode: Boolean;
+    FShowEconomicMark: Boolean;
+    FShowDesignQuantity: Boolean;
+    FUploadURL: string;
+
+    function CreateInitFile: TIniFile;
+    function GetStandardItemLibs(const AProjType: string): TStrings;
+  public
+    destructor Destroy; override;
+
+    procedure LoadIniFile(const AIniFileName: string);
+    procedure SaveIniFile;
+
+    property Strings: TStrings read FStrings;
+    {all kinds of properties}
+    property AutoSaveInterval  : Integer read FAutoSaveInterval write FAutoSaveInterval;
+
+    property AllowMfyCode      : Boolean read FAllowMfyCode write FAllowMfyCode;
+    property AutoSaveProjects  : Boolean read FAutoSaveProjects write FAutoSaveProjects;
+    property SaveAllProjects   : Boolean read FSaveAllProjects write FSaveAllProjects;
+    property SaveRestorePoint  : Boolean read FSaveRestorePoint write FSaveRestorePoint;
+    property AutoCollapse      : Boolean read FAutoCollapse write FAutoCollapse;
+    property RealTimeCalc      : Boolean read FRealTimeCalc write FRealTimeCalc;
+    property MatchCodeOnly     : Boolean read FMatchCodeOnly write FMatchCodeOnly;
+
+    property ShowDesignQuantity: Boolean read FShowDesignQuantity write FShowDesignQuantity;
+    property ShowEconomicMark  : Boolean read FShowEconomicMark write FShowEconomicMark;
+    property ShowDrawingCode   : Boolean read FShowDrawingCode write FShowDrawingCode;
+
+    // ÒÔÏÂURL by chenshilong, 2012-6-4
+    property SearchURL: string read FSearchURL;
+    property WebSoftURL: string read FWebSoftURL;
+    property LoginURL: string read FLoginURL;
+    property WebLoginURL: string read FWebLoginURL;
+    property LogoutURL: string read FLogoutURL;
+    property RegURL: string read FRegURL;
+    property PwdURL: string read FPwdURL;
+    property CheckOnLineURL: string read FCheckOnLineURL;
+    property ServerDateTimeURL: string read FServerDateTimeURL;
+    property OldUserResetPwdURL: string read FOldUserResetPwdURL;
+    Property JumpURL: string read FJumpURL;
+    property UploadURL: string read FUploadURL;
+  end;
+
+var
+  ScConfigInfo: TScConfigInfo;
+
+  function ConfigInfo: TScConfigInfo;
+
+implementation
+
+function ConfigInfo: TScConfigInfo;
+begin
+  Result := ScConfigInfo;
+end;
+
+{ TScConfigInfo }
+
+function IniFileFullPath: string;
+begin
+  Result := ExtractFilePath(ParamStr(0)) + 'config.ini';
+end;
+
+function TScConfigInfo.CreateInitFile: TIniFile;
+var
+  sFileName: string;
+begin
+  sFileName := FIniFileName;
+  if not FileExists(sFileName) then
+  begin
+    Result := nil;
+    Exit;
+  end;
+  Result := TIniFile.Create(sFileName);
+end;
+
+destructor TScConfigInfo.Destroy;
+begin
+  FStrings.Free;
+  inherited;
+end;
+
+function TScConfigInfo.GetStandardItemLibs(
+  const AProjType: string): TStrings;
+var
+  Ini: TIniFile;
+  KeyNames: TStringList;
+  I: Integer;
+  sTemp: string;
+  sKeyNamePrefix: string;
+begin
+  Result := TStringList.Create;
+  
+  Ini := CreateInitFile;
+  if Ini = nil then Exit;
+  KeyNames := TStringList.Create;
+  try
+    Ini.ReadSection(SStandardLibs, KeyNames);
+
+    sKeyNamePrefix := AProjType + 'Lib';
+    for I := 0 to KeyNames.Count - 1 do
+    begin
+      if AnsiPos(sKeyNamePrefix, KeyNames[I]) > 0 then
+      begin
+        sTemp := Trim(Ini.ReadString(SStandardLibs, KeyNames[I], ''));
+        if sTemp <> '' then
+          Result.Add(FixPathByAppPath(sTemp));
+      end;
+    end;
+  finally
+    KeyNames.Free;
+    Ini.Free;
+  end;
+end;
+
+procedure TScConfigInfo.LoadIniFile(const AIniFileName: string);
+var
+  Ini: TIniFile;
+begin
+  Ini := TIniFile.Create(AIniFileName);
+  try
+    FIniFileName := AIniFileName;
+    {Load std Bills Lib}
+    FStrings := GetStandardItemLibs(SProjectType);
+    {Load other options}
+    FAllowMfyCode     := Ini.ReadBool(SGeneralOptions, SAllowMfyCode, False);
+    FAutoSaveProjects := Ini.ReadBool(SGeneralOptions, SAutoSaveProjects, True);
+    FSaveAllProjects  := Ini.ReadBool(SGeneralOptions, SSaveAllProjects, True);
+    FSaveRestorePoint := Ini.ReadBool(SGeneralOptions, SSaveRestorePoint, True);
+    FAutoCollapse     := Ini.ReadBool(SGeneralOptions, SAutoCollapse, True);
+    FRealTimeCalc     := Ini.ReadBool(SGeneralOptions, SRealTimeCalc, True);
+    FMatchCodeOnly    := Ini.ReadBool(SGatherOptions, SMatchCodeOnly, True);
+
+    FShowDesignQuantity := Ini.ReadBool('ViewOptions', 'ShowDesignQuantity', True);
+    FShowEconomicMark := Ini.ReadBool('ViewOptions', 'ShowEconomicMark', True);
+    FShowDrawingCode  := Ini.ReadBool('ViewOptions', 'ShowDrawingCode', False);
+
+    FAutoSaveInterval := Ini.ReadInteger(SGeneralOptions, SAutoSaveInterval, 5);
+
+    FSearchURL := Ini.ReadString('URL', 'SearchURL', '');
+    FWebSoftURL := Ini.ReadString('URL', 'WebSoftURL', '');
+    FLoginURL := FWebSoftURL + Ini.ReadString('URL', 'LoginURL', '');
+    FWebLoginURL := FWebSoftURL + Ini.ReadString('URL', 'WebLoginURL', '');
+    FRegURL := FWebSoftURL + Ini.ReadString('URL', 'RegURL', '');
+    FPwdURL := FWebSoftURL + Ini.ReadString('URL', 'PwdURL', '');
+    FCheckOnLineURL := FWebSoftURL + Ini.ReadString('URL', 'CheckOnLineURL', '');
+    FLogoutURL := FWebSoftURL + Ini.ReadString('URL', 'LogoutURL', '');
+    FServerDateTimeURL := FWebSoftURL + Ini.ReadString('URL', 'ServerDateTimeURL', '');
+    FOldUserResetPwdURL := FWebSoftURL + Ini.ReadString('URL', 'OldUserResetPwdURL', '');
+    FJumpURL := FWebSoftURL + Ini.ReadString('URL', 'JumpURL', 'ScJump.php');
+    FUploadURL := FWebSoftURL + Ini.ReadString('URL', 'UploadURL', 'ScUploadFile.php');
+  finally
+    Ini.Free;
+  end;
+end;
+
+procedure TScConfigInfo.SaveIniFile;
+var
+  Ini: TIniFile;
+begin
+  Ini := TIniFile.Create(FIniFileName);
+  try
+    {save other options}
+    Ini.WriteBool(SGeneralOptions, SAllowMfyCode, FAllowMfyCode);
+    Ini.WriteBool(SGeneralOptions, SAutoSaveProjects, FAutoSaveProjects);
+    Ini.WriteBool(SGeneralOptions, SSaveAllProjects, FSaveAllProjects);
+    Ini.WriteBool(SGeneralOptions, SSaveRestorePoint, FSaveRestorePoint);
+    Ini.WriteBool(SGeneralOptions, SAutoCollapse, FAutoCollapse);
+    Ini.WriteBool(SGeneralOptions, SRealTimeCalc, FRealTimeCalc);
+    Ini.WriteBool(SGatherOptions, SMatchCodeOnly, FMatchCodeOnly);
+
+    Ini.WriteBool('ViewOptions', 'ShowDesignQuantity', FShowDesignQuantity);
+    Ini.WriteBool('ViewOptions', 'ShowEconomicMark', FShowEconomicMark);
+    Ini.WriteBool('ViewOptions', 'ShowDrawingCode', FShowDrawingCode);
+
+    Ini.WriteInteger(SGeneralOptions, SAutoSaveInterval, FAutoSaveInterval);
+  finally
+    Ini.Free;
+  end;
+end;
+
+initialization
+  ScConfigInfo := TScConfigInfo.Create;
+  ScConfigInfo.LoadIniFile(IniFileFullPath);
+
+finalization
+  ScConfigInfo.Free;
+
+end.

+ 813 - 0
CU/ScCopyBills.pas

@@ -0,0 +1,813 @@
+unit ScCopyBills;
+
+interface
+
+uses
+  Classes, SysUtils, XMLDoc, XMLIntf, Math, Controls, ScProjectManager,
+  DB, DBClient, Contnrs, Windows, ScBillsTree, ConstVarUnit, DataBase,
+  ConstTypeUnit;
+
+var
+  CF_Bills: Word;
+  CF_Rations: Word;
+
+type
+
+  TScXMLSaver = class(TObject)
+  private
+    FMajorID: Integer;
+    FPasteCount: Integer;
+    FBillsData: TDMDataBase;
+    FBillIDsList: TObjectList;
+
+    procedure LoadBillsItem(ABillRec: TBillIDRecord; ANode: IXMLNode;
+      var ANewDQID: Integer; ABillsQty, ADQQty: Boolean);
+    procedure InternalAddBillRecd(xNode: IXMLNode; var ABillsID, ANewDQID: Integer;
+      ABillsQty, ADQQty: Boolean);
+    procedure RepairTreeStruct(var ALastNextNewID, ALastNextOldID: Integer;
+      AParentID: Integer; AIsNew: Boolean);
+    {复制方法}
+    procedure SaveDrawingQuantity(ANode: IXMLNode; ABillID: Integer);
+    procedure SaveExprsInXMLNode(ANode: IXMLNode);
+    procedure SaveBillsExprs(ANode: IXMLNode; ABillsID: Integer);
+    procedure SaveDrawingItemExprs(ANode: IXMLNode; ADrawingID: Integer);
+    {粘贴方法}
+    procedure LoadBillsForpaste(ANode: IXMLNode; var ABillID: Integer; AIsNew: Boolean;
+      AItem: TScBillsItem; ABillsQty, ADQQty: Boolean);
+
+    procedure LoadBillsExprs(ANode: IXMLNode; ABillsID: Integer);
+    procedure LoadDrawingItemExprs(ANode: IXMLNode; ADrawingID: Integer);
+
+    procedure LoadDrawingQuantityForPaste(ANode: IXMLNode; var ANewID: Integer;
+      ABillID: Integer; AClearQty: Boolean; AClearBillsQty: Boolean = False);
+  protected
+    function CreateXMLDoc: IXMLDocument;
+  public
+    constructor Create(ABillsData: TDMDataBase); virtual;
+    destructor Destroy; override;
+
+    property BillsData: TDMDataBase read FBillsData;
+  end;
+
+  TScCopyType = (ctBills, ctRations);
+
+  TScXMLClipboard = class(TScXMLSaver)
+  private
+    function SelectPastePos(var ABillsQty, ADQQty, ANew: Boolean; var ANewID, APos: Integer; var AItem: TScBillsItem): Boolean;
+    function GetFirstLevelCount(aRoot: IXMLNode): Integer;
+    procedure LocateNew(aPos, aIndex, aCount: Integer);
+    procedure CollapseNew(aPos, aCount: Integer; aItem: TScBillsItem);
+  private
+    function SaveBillsItemForCopy(AItem: TScBillsItem; ANode: IXMLNode): IXMLNode;
+    procedure SaveBillsForCopy(AIndex1, AIndex2: Integer; ANode: IXMLNode);
+
+    procedure CopyBillsToXml(AXmlDoc: IXMLDocument; AIndex1, AIndex2: Integer);
+    procedure PasteBillsFromXml(AXmlDoc: IXMLDocument; AIndex: Integer);
+  protected
+    procedure SaveXMLToClipboard(AFormat: Word; AXMLDoc: IXMLDocument);
+    procedure LoadXMLFromClipboard(AFormat: Word; AXMLDoc: IXMLDocument);
+
+  public
+    constructor Create(aBillsData: TDMDataBase); override;
+    {复制清单}
+    procedure CopyBillsToClipboard(Index1, Index2: Integer);
+    {粘贴清单}
+    procedure PasteBillsFromClipboard(aIndex: Integer);
+
+    {复制清单保存成文件}
+    procedure CopyBillsToFile(const AFileName: string; AIndex1, AIndex2: Integer);
+    {从文件中粘贴清单}
+    procedure PasteBillsFromFile(const AFileName: string; AIndex: Integer);
+  end;
+
+
+implementation
+
+uses
+  Forms, Variants, Clipbrd, ZjIDTree, CheckPosForm, ConstMethodUnit, ScConfig,
+  ScExprsDM;
+
+
+{ TScXMLSaver }
+
+constructor TScXMLSaver.Create(ABillsData: TDMDataBase);
+begin
+  FBillsData := ABillsData;
+  FBillIDsList := TObjectList.Create;
+end;
+
+function TScXMLSaver.CreateXMLDoc: IXMLDocument;
+begin
+  Result := TXMLDocument.Create(nil) as IXMLDocument;
+  Result.Active := True;
+
+  Result.Encoding := 'gb2312';
+  Result.Options := Result.Options + [doNodeAutoIndent];
+  Result.AddChild('SmartCost');
+end;
+
+destructor TScXMLSaver.Destroy;
+begin
+  FBillIDsList.Free;
+  inherited;
+end;
+
+procedure TScXMLSaver.InternalAddBillRecd(xNode: IXMLNode;
+  var ABillsID, ANewDQID: Integer; ABillsQty, ADQQty: Boolean);
+var
+  bRec: TBillIDRecord;
+begin
+  if not Assigned(xNode) then Exit;
+
+  if SameText(xNode.NodeName, c_BillsItem) then
+  begin
+    bRec := TBillIDRecord.Create;
+    bRec.OldID := xNode.Attributes[c_ID];
+    bRec.ParentID := xNode.Attributes[c_ParentID];
+    bRec.NextSiblingID := xNode.Attributes[c_NextSiblingID];
+    bRec.NewID := ABillsID;
+    LoadBillsItem(bRec, xNode, ANewDQID, ABillsQty, ADQQty);
+    FBillIDsList.Add(bRec);
+    Inc(ABillsID);
+  end;
+
+  if xNode.HasChildNodes then
+    InternalAddBillRecd(xNode.ChildNodes[0], ABillsID, ANewDQID, ABillsQty, ADQQty);
+  if Assigned(xNode.NextSibling) then
+    InternalAddBillRecd(xNode.NextSibling, ABillsID, ANewDQID, ABillsQty, ADQQty);
+end;
+
+procedure TScXMLSaver.LoadBillsExprs(ANode: IXMLNode; ABillsID: Integer);
+
+  procedure LoadExprs(AXMLNode: IXMLNode);
+  begin
+    with FBillsData.DMExprs do
+    begin
+      cdsOrgExprs.Append;
+      cdsOrgExprsMajorID.Value := AXMLNode.Attributes[c_MajorID];
+      cdsOrgExprsMinorID.Value := AXMLNode.Attributes[c_MinorID];
+      cdsOrgExprsRecdID.Value := ABillsID;
+      cdsOrgExprsExprs.Value := AXMLNode.Attributes[c_Exprs];
+      cdsOrgExprsExprs1.Value := AXMLNode.Attributes[c_Exprs1];
+      cdsOrgExprsFlag.Value := AXMLNode.Attributes[c_Flag];
+      cdsOrgExprsExprsValue.Value := AXMLNode.Attributes[c_ExprsValue];
+      cdsOrgExprs.Post;
+    end;
+  end;
+
+var
+  I: Integer;
+  xmlNode: IXMLNode;
+begin
+  xmlNode := ANode.ChildNodes.FindNode(c_BillsExprs);
+  if xmlNode <> nil then
+  begin
+    for I := 0 to xmlNode.ChildNodes.Count - 1 do
+      LoadExprs(xmlNode.ChildNodes[I]);
+  end;
+end;
+
+procedure TScXMLSaver.LoadBillsForpaste(ANode: IXMLNode;
+  var ABillID: Integer; AIsNew: Boolean; AItem: TScBillsItem;
+  ABillsQty, ADQQty: Boolean);
+var
+  iNewDQID: Integer;
+  vNode: IXMLNode;
+  iOldNextSiblingID, iParentID, iCurID: Integer;
+  iLastNextSiblingNewID, iLastNextSiblingOldID: Integer;
+begin
+  if not Assigned(AItem) then Exit;
+
+  iNewDQID := FBillsData.GetMaxDrawingQuangtiyID;
+  iOldNextSiblingID := -1;
+
+  with FBillsData do
+  begin
+    iCurID := AItem.ID;
+    if not ModifyNextSiblingID(iCurID, ABillID, iParentID, iOldNextSiblingID)
+      then Exit;
+
+    DisconnectBillsTree;
+    try
+      ANode := ANode.ChildNodes.FindNode(c_BillsList);
+
+      if Assigned(ANode) and (ANode.ChildNodes.Count > 0) then
+      begin
+        vNode := ANode.ChildNodes[0];
+        iLastNextSiblingOldID := vNode.Attributes[c_ID];
+        iLastNextSiblingNewID := ABillID;
+        InternalAddBillRecd(vNode, ABillID, iNewDQID, ABillsQty, ADQQty);
+      end;
+
+      FPasteCount := FBillIDsList.Count;
+      
+      RepairTreeStruct(iLastNextSiblingNewID, iLastNextSiblingOldID, iParentID, AIsNew);
+      WriteRecIntoDB(FBillIDsList);
+
+      if (iLastNextSiblingNewID <> iOldNextSiblingID) then
+        ModifyNextSiblingID(iLastNextSiblingNewID, iOldNextSiblingID);
+
+      if AIsNew then DeleteBills(iCurID);
+
+    finally
+      ConnectionBillsTree;
+    end;
+  end;
+
+end;
+
+procedure TScXMLSaver.LoadBillsItem(ABillRec: TBillIDRecord;
+  ANode: IXMLNode; var ANewDQID: Integer; ABillsQty, ADQQty: Boolean);
+begin
+  ABillRec.Code := VarToStr(ANode.Attributes[c_Code]);
+  ABillRec.Name := VarToStr(ANode.Attributes[c_Name]);
+  ABillRec.Units := VarToStr(ANode.Attributes[c_Units]);
+
+  if ABillsQty then
+  begin
+    ABillRec.Quantity := 0;
+    ABillRec.DesignQuantity := 0;
+    ABillRec.DesignQuantity2 := 0;
+    ABillRec.DesignPrice := 0;
+    ABillRec.UnitPrice := 0;
+    ABillRec.TotalPrice := 0;
+  end
+  else
+  begin
+    ABillRec.Quantity := ANode.Attributes[c_Quantity];
+    ABillRec.DesignQuantity := ANode.Attributes[c_DesignQuantity1];
+    ABillRec.DesignQuantity2 := ANode.Attributes[c_DesignQuantity2];
+    ABillRec.DesignPrice := ANode.Attributes[c_DesignPrice];
+    ABillRec.UnitPrice := ANode.Attributes[c_UnitPrice];
+    ABillRec.TotalPrice := ANode.Attributes[c_TotalPrice];
+  end;
+
+  ABillRec.B_Code := ANode.Attributes[c_BCode];
+  ABillRec.MemoStr := ANode.Attributes[c_MemoString];
+
+  LoadDrawingQuantityForPaste(ANode, ANewDQID, ABillRec.NewID, ADQQty, ABillsQty);
+  LoadBillsExprs(ANode, ABillRec.NewID);
+end;
+
+procedure TScXMLSaver.LoadDrawingItemExprs(ANode: IXMLNode;
+  ADrawingID: Integer);
+
+  procedure LoadExprs(AXMLNode: IXMLNode);
+  begin
+    with FBillsData.DMExprs do
+    begin
+      cdsOrgExprs.Append;
+      cdsOrgExprsMajorID.Value := AXMLNode.Attributes[c_MajorID];
+      cdsOrgExprsMinorID.Value := AXMLNode.Attributes[c_MinorID];
+      cdsOrgExprsRecdID.Value := ADrawingID;
+      cdsOrgExprsExprs.Value := AXMLNode.Attributes[c_Exprs];
+      cdsOrgExprsExprs1.Value := AXMLNode.Attributes[c_Exprs1];
+      cdsOrgExprsFlag.Value := AXMLNode.Attributes[c_Flag];
+      cdsOrgExprsExprsValue.Value := AXMLNode.Attributes[c_ExprsValue];
+      cdsOrgExprs.Post;
+    end;
+  end;
+
+var
+  I: Integer;
+  xmlNode: IXMLNode;
+begin
+  xmlNode := ANode.ChildNodes.FindNode(c_DrawingExprs);
+  if xmlNode <> nil then
+  begin
+    for I := 0 to xmlNode.ChildNodes.Count - 1 do
+      LoadExprs(xmlNode.ChildNodes[I]);
+  end;
+end;
+
+procedure TScXMLSaver.LoadDrawingQuantityForPaste(ANode: IXMLNode;
+  var ANewID: Integer; ABillID: Integer; AClearQty: Boolean; AClearBillsQty: Boolean);
+var
+  I, iSerinalNo: Integer;
+  vNode: IXMLNode;
+begin
+  ANode := ANode.ChildNodes.FindNode(c_DrawQList);
+  if ANode = nil then Exit;
+  
+  with FBillsData do
+  begin
+    iSerinalNo := 1;
+    for I := 0 to ANode.ChildNodes.Count - 1 do
+    begin
+      vNode := ANode.ChildNodes[I];
+      
+      cdsDrawingQuantity.Insert;
+      cdsDrawingQuantityID.Value := ANewID;
+      cdsDrawingQuantityBillsID.Value := ABillID;
+      cdsDrawingQuantitySerinalNo.Value := iSerinalNo;
+      cdsDrawingQuantityName.Value := vNode.Attributes[c_Name];
+      cdsDrawingQuantityUnits.Value := vNode.Attributes[c_Units];
+      if AClearBillsQty then
+        cdsDrawingQuantityIsGatherQ.AsBoolean := False 
+      else
+        cdsDrawingQuantityIsGatherQ.Value := vNode.Attributes[c_IsGatherQty];
+      if AClearQty then
+      begin
+        cdsDrawingQuantityDQuantity1.Value := 0;
+        cdsDrawingQuantityDQuantity2.Value := 0;
+      end
+      else
+      begin
+        cdsDrawingQuantityDQuantity1.Value := vNode.Attributes[c_DesignQuantity1];
+        cdsDrawingQuantityDQuantity2.Value := vNode.Attributes[c_DesignQuantity2];
+      end;
+      cdsDrawingQuantityMemoContext.Value := vNode.Attributes[c_MemoString];
+      cdsDrawingQuantity.Post;
+
+      LoadDrawingItemExprs(vNode, ANewID);
+      
+      Inc(ANewID);
+      Inc(iSerinalNo);
+    end;
+  end;
+end;
+
+procedure TScXMLSaver.RepairTreeStruct(var ALastNextNewID, ALastNextOldID: Integer;
+  AParentID: Integer; AIsNew: Boolean);
+var
+  I, J: Integer;
+  billIDRecd, billRec: TBillIDRecord;
+begin
+  for I := 0 to FBillIDsList.Count - 1 do
+  begin
+    billIDRecd := TBillIDRecord(FBillIDsList[I]);
+    if (billIDRecd.OldID = ALastNextOldID) then
+    begin
+      if (billIDRecd.NextSiblingID <> -1) or AIsNew then
+      begin
+        ALastNextOldID := billIDRecd.NextSiblingID;
+      end;
+      ALastNextNewID := billIDRecd.NewID;
+      billIDRecd.ParentID := AParentID;
+      billIDRecd.ParentChanged := True;
+    end;
+
+    for J := 0 to FBillIDsList.Count - 1 do
+    begin
+      billRec := TBillIDRecord(FBillIDsList[J]);
+      if (billRec.ParentID = billIDRecd.OldID) and (not billRec.ParentChanged) then
+      begin
+        billRec.ParentID := billIDRecd.NewID;
+        billRec.ParentChanged := True;
+      end
+      else if (billRec.NextSiblingID = billIDRecd.OldID) and (not billRec.NextSiblingChanged) then
+      begin
+        billRec.NextSiblingID := billIDRecd.NewID;
+        billRec.NextSiblingChanged := True;
+      end;
+    end;
+  end;
+end;
+
+procedure TScXMLSaver.SaveBillsExprs(ANode: IXMLNode; ABillsID: Integer);
+var
+  xmlExprs: IXMLNode;
+begin
+  with FBillsData.DMExprs do
+  begin
+    xmlExprs := ANode.AddChild(c_BillsExprs);
+    cdsOrgExprs.SetRange([1, ABillsID], [1, ABillsID]);
+    cdsOrgExprs.First;
+    while not cdsOrgExprs.Eof do
+    begin
+      SaveExprsInXMLNode(xmlExprs.AddChild(c_BillsExprsItem));
+      cdsOrgExprs.Next;
+    end;
+    cdsOrgExprs.CancelRange;
+  end;
+end;
+
+procedure TScXMLSaver.SaveDrawingItemExprs(ANode: IXMLNode;
+  ADrawingID: Integer);
+var
+  xmlExprs: IXMLNode;
+begin
+  with FBillsData.DMExprs do
+  begin
+    xmlExprs := ANode.AddChild(c_DrawingExprs);
+    cdsOrgExprs.SetRange([2, ADrawingID], [2, ADrawingID]);
+    cdsOrgExprs.First;
+    while not cdsOrgExprs.Eof do
+    begin
+      SaveExprsInXMLNode(xmlExprs.AddChild(c_DrawingExprsItem));
+      cdsOrgExprs.Next;
+    end;
+    cdsOrgExprs.CancelRange;
+  end;
+end;
+
+procedure TScXMLSaver.SaveDrawingQuantity(ANode: IXMLNode;
+  ABillID: Integer);
+var
+  xmlDrawItem: IXMLNode;
+begin
+  with FBillsData do
+  begin
+    cdsDQForLocate.SetRange([ABillID], [ABillID]);
+    if cdsDQForLocate.RecordCount > 0 then
+      ANode := ANode.AddChild(c_DrawQList);
+    cdsDQForLocate.First;
+    while not cdsDQForLocate.Eof do
+    begin
+      xmlDrawItem := ANode.AddChild(c_DQItem);
+      xmlDrawItem.Attributes[c_BillsID] := cdsDQForLocateBillsID.AsInteger;
+      xmlDrawItem.Attributes[c_Name] := cdsDQForLocateName.AsString;
+      xmlDrawItem.Attributes[c_Units] := cdsDQForLocateUnits.AsString;
+      xmlDrawItem.Attributes[c_DesignQuantity1] := cdsDQForLocateDQuantity1.AsFloat;
+      xmlDrawItem.Attributes[c_DesignQuantity2] := cdsDQForLocateDQuantity2.AsFloat;
+      xmlDrawItem.Attributes[c_MemoString] := cdsDQForLocateMemoContext.AsString;
+      xmlDrawItem.Attributes[c_IsGatherQty] := cdsDQForLocateIsGatherQ.AsBoolean;
+      SaveDrawingItemExprs(xmlDrawItem, cdsDQForLocateID.AsInteger);
+      cdsDQForLocate.Next;
+    end;
+    cdsDQForLocate.CancelRange;
+  end;
+end;
+
+procedure TScXMLSaver.SaveExprsInXMLNode(ANode: IXMLNode);
+begin
+  with FBillsData.DMExprs do
+  begin
+    ANode.Attributes[c_MajorID] := cdsOrgExprsMajorID.AsInteger;
+    ANode.Attributes[c_MinorID] := cdsOrgExprsMinorID.AsInteger;
+    ANode.Attributes[c_RecdID] := cdsOrgExprsRecdID.AsInteger;
+    ANode.Attributes[c_Exprs] := cdsOrgExprsExprs.AsString;
+    ANode.Attributes[c_Exprs1] := cdsOrgExprsExprs1.AsString;
+    ANode.Attributes[c_Flag] := cdsOrgExprsFlag.AsInteger;
+    ANode.Attributes[c_ExprsValue] := cdsOrgExprsExprsValue.AsFloat;
+  end;
+end;
+
+{ TScXMLClipboard }
+
+procedure TScXMLClipboard.CollapseNew(aPos, aCount: Integer; aItem: TScBillsItem);
+begin
+  case aPos of
+    cp_Next:
+             begin
+                while Assigned(aItem) and (aCount > 0) do
+                begin
+                  aItem.Collapse;
+                  aItem := TScBillsItem(aItem.NextSibling);
+                  Dec(aCount);
+                end;
+             end;
+    cp_Font, cp_Child:
+             begin
+                while Assigned(aItem) and (aCount > 0) do
+                begin
+                  aItem.Collapse;
+                  aItem := TScBillsItem(aItem.PrevSibling);
+                  Dec(aCount);
+                end;
+             end;
+  end;
+end;
+
+procedure TScXMLClipboard.CopyBillsToClipboard(Index1, Index2: Integer);
+var
+  xmlDoc: IXMLDocument;
+begin
+  xmlDoc := CreateXMLDoc;
+  try
+    CopyBillsToXml(xmlDoc, Index1, Index2);
+    // 将XML文件流按照CF_Rations格式保存到剪贴板中
+    SaveXMLToClipboard(CF_Bills, xmlDoc);
+  finally
+    xmlDoc := nil;
+  end;
+end;
+
+procedure TScXMLClipboard.CopyBillsToFile(const AFileName: string; AIndex1,
+  AIndex2: Integer);
+var
+  xmlDoc: IXMLDocument;
+begin
+  xmlDoc := CreateXMLDoc;
+  try
+    CopyBillsToXml(xmlDoc, AIndex1, AIndex2);
+    if not DirectoryExists(ExtractFilePath(AFileName)) then
+      ForceDirectories(ExtractFilePath(AFileName));
+    xmlDoc.SaveToFile(AFileName);
+  finally
+    xmlDoc := nil;
+  end;
+end;
+
+procedure TScXMLClipboard.CopyBillsToXml(AXmlDoc: IXMLDocument; AIndex1,
+  AIndex2: Integer);
+var
+  xmlBillsList, xmlRoot: IXMLNode;
+begin
+  if AIndex1 > AIndex2 then Exit;
+
+  xmlRoot := AXmlDoc.DocumentElement;
+
+  // 增加清单列表接点
+  xmlBillsList := xmlRoot.AddChild(c_BillsList);
+
+  AIndex1 := Max(0, AIndex1);
+  AIndex2 := Min(FBillsData.BillsTree.Count - 1, AIndex2);
+
+  SaveBillsForCopy(AIndex1, AIndex2, xmlBillsList);
+end;
+
+constructor TScXMLClipboard.Create(aBillsData: TDMDataBase);
+begin
+  inherited Create(aBillsData);
+
+end;
+
+function TScXMLClipboard.GetFirstLevelCount(aRoot: IXMLNode): Integer;
+var
+  cNode: IXMLNode;
+begin
+  cNode := aRoot.ChildNodes.FindNode(c_BillsList);
+  Result := cNode.ChildNodes.Count;
+end;
+
+procedure TScXMLClipboard.LoadXMLFromClipboard(AFormat: Word;
+  AXMLDoc: IXMLDocument);
+var
+  MemStrm: TMemoryStream;
+  Data: THandle;
+  DataPtr: Pointer;
+begin
+  with Clipboard do
+  begin
+    Open;
+    try
+      Data := GetClipboardData(AFormat);
+      if Data = 0 then Exit;
+
+      DataPtr := GlobalLock(Data);
+      try
+        MemStrm := TMemoryStream.Create;
+        try
+          MemStrm.WriteBuffer(DataPtr^, GlobalSize(Data));
+          MemStrm.Position := 0;
+          AXMLDoc.LoadFromStream(MemStrm);
+        finally
+          MemStrm.Free;
+        end;
+      finally
+        GlobalUnlock(Data);
+      end;
+    finally
+      Close;
+    end;
+  end;
+end;
+
+procedure TScXMLClipboard.LocateNew(aPos, aIndex, aCount: Integer);
+var
+  cItem: TScBillsItem;
+begin
+  cItem := FBillsData.BillsTree[aIndex];
+  case aPos of
+    cp_Next:
+            begin
+              cItem := TScBillsItem(cItem.NextSibling);
+              if Assigned(cItem) then
+                cItem.LocateDBRecord;
+            end;
+    cp_Font:
+            begin
+              cItem := TScBillsItem(cItem.PrevSibling);
+              if Assigned(cItem) then
+                cItem.LocateDBRecord;
+            end;
+    cp_Child:
+            begin
+              cItem := TScBillsItem(cItem.LastChild);
+              if Assigned(cItem) then
+                cItem.LocateDBRecord;
+            end;
+  end;
+
+  if ScConfigInfo.AutoCollapse then
+    CollapseNew(aPos, aCount, cItem);
+end;
+
+procedure TScXMLClipboard.PasteBillsFromClipboard(aIndex: Integer);
+var
+  xmlDoc: IXMLDocument;
+begin
+  if (aIndex >= FBillsData.BillsTree.Count) or (aIndex < -1) then Exit; 
+
+  xmlDoc := CreateXMLDoc;
+  try
+    LoadXMLFromClipboard(CF_Bills, xmlDoc);
+    PasteBillsFromXml(xmlDoc, aIndex);
+  finally
+    xmlDoc := nil;
+  end;
+end;
+
+procedure TScXMLClipboard.PasteBillsFromFile(const AFileName: string;
+  AIndex: Integer);
+var
+  xmlDoc: IXMLDocument;
+begin
+  if (AIndex >= FBillsData.BillsTree.Count) or (AIndex < -1) then Exit; 
+
+  xmlDoc := CreateXMLDoc;
+  try
+    xmlDoc.LoadFromFile(AFileName);
+    PasteBillsFromXml(xmlDoc, AIndex);
+  finally
+    xmlDoc := nil;
+  end;
+end;
+
+procedure TScXMLClipboard.PasteBillsFromXml(AXmlDoc: IXMLDocument;
+  AIndex: Integer);
+var
+  vRoot: IXMLNode;
+  vItem: TScBillsItem;
+  bBillsQty: Boolean;
+  bDQQty: Boolean;
+  bNew: Boolean;
+  bIsPPBills: Boolean;
+  iNewBillID, iPos, iCount: Integer;
+begin
+  bNew       := False;
+  bBillsQty  := False;
+  bDQQty     := False;
+  bIsPPBills := False;
+
+  vItem := FBillsData.BillsTree.Items[aIndex];
+  if vItem = nil then Exit;
+
+  vRoot := AXmlDoc.DocumentElement;
+  if vRoot = nil then Exit;
+  iCount := GetFirstLevelCount(vRoot);
+  iNewBillID := FBillsData.GetMaxBillsID;
+
+  aIndex := vItem.ID;
+  FBillsData.SaveStatus;
+
+  if not SelectPastePos(bBillsQty, bDQQty, bNew, iNewBillID, iPos, vItem) then Exit;
+
+  Screen.Cursor := crHourGlass;
+  if FBillsData.IsProjectBills then
+  begin
+    bIsPPBills := True;
+    FBillsData.IsProjectBills := False;
+  end;
+  FBillsData.EnabledUITreeEvt(False, False);
+  try
+    LoadBillsForpaste(vRoot, iNewBillID, bNew, vItem, bBillsQty, bDQQty);
+  finally
+    FBillsData.ReadStatus(FMajorID, FPasteCount);
+    FBillsData.EnabledUITreeEvt(True, False);
+    LocateNew(iPos, aIndex, iCount);
+    Screen.Cursor := crDefault;
+    if bIsPPBills then
+      FBillsData.IsProjectBills := bIsPPBills;
+  end;
+end;
+
+procedure TScXMLClipboard.SaveBillsForCopy(AIndex1, AIndex2: Integer;
+  ANode: IXMLNode);
+var
+  vChildNode: IXMLNode;
+  vItem: TScBillsItem;
+  iIndex: Integer;
+begin
+  if AIndex1 > AIndex2 then Exit;
+
+  vItem := FBillsData.BillsTree.Items[AIndex1];
+
+  while Assigned(vItem) and (vItem.MajorIndex <= AIndex2) do
+  begin
+
+    vChildNode := SaveBillsItemForCopy(vItem, ANode);
+
+    if vItem.HasChildren then
+    begin
+      iIndex := vItem.FirstChild.MajorIndex;
+      // 用AIndex2则只复制到选择范围内,用MaxInt表示复制所有子项,即使不在选择范围内
+      SaveBillsForCopy(iIndex, MaxInt, vChildNode);
+    end;
+
+    vItem := TScBillsItem(vItem.NextSibling);
+  end;
+end;
+
+function TScXMLClipboard.SaveBillsItemForCopy(AItem: TScBillsItem;
+  ANode: IXMLNode): IXMLNode;
+
+  procedure SaveXMLBillsItem(AXMLNode: IXMLNode);
+  begin
+    with FBillsData do
+    begin
+      AXMLNode.Attributes[c_ID] := cdsBillsID.Value;
+      AXMLNode.Attributes[c_ParentID] := cdsBillsParentID.Value;
+      AXMLNode.Attributes[c_NextSiblingID] := cdsBillsNextSiblingID.Value;
+      AXMLNode.Attributes[c_Code] := cdsBillsCode.AsString;
+      AXMLNode.Attributes[c_Name] := cdsBillsName.AsString;
+      AXMLNode.Attributes[c_Units] := cdsBillsUnits.AsString;
+
+      AXMLNode.Attributes[c_BCode] := cdsBillsB_Code.AsString;
+      AXMLNode.Attributes[c_DesignQuantity1] := cdsBillsDesignQuantity.AsFloat;
+      AXMLNode.Attributes[c_DesignQuantity2] := cdsBillsDesignQuantity2.AsFloat;
+      AXMLNode.Attributes[c_DesignPrice] := cdsBillsDesignPrice.AsFloat;
+
+      AXMLNode.Attributes[c_Quantity] := cdsBillsQuantity.AsFloat;
+      AXMLNode.Attributes[c_UnitPrice] := cdsBillsUnitPrice.AsFloat;
+      AXMLNode.Attributes[c_TotalPrice] := cdsBillsTotalPrice.AsFloat;
+      AXMLNode.Attributes[c_MemoString] := cdsBillsMemoStr.AsString;
+    end;
+  end;
+
+begin
+  Result := nil;
+  if FBillsData.cdsBills.FindKey([AItem.ID]) then
+  begin
+    Result := ANode.AddChild(c_BillsItem);
+    SaveXMLBillsItem(Result);
+    SaveDrawingQuantity(Result, AItem.ID);
+    SaveBillsExprs(Result, AItem.ID);
+  end;
+end;
+
+Type
+  TClipboardAccess = class(TClipboard);
+
+procedure TScXMLClipboard.SaveXMLToClipboard(AFormat: Word;
+  AXMLDoc: IXMLDocument);
+var
+  MemStrm: TMemoryStream;
+begin
+  MemStrm := TMemoryStream.Create;
+  try
+    AxmlDoc.SaveToStream(MemStrm);
+    MemStrm.Position := 0;
+    TClipboardAccess(Clipboard).SetBuffer(AFormat, MemStrm.Memory^, MemStrm.Size);
+  finally
+    MemStrm.Free;
+  end;
+end;
+
+function TScXMLClipboard.SelectPastePos(var ABillsQty, ADQQty,
+  ANew: Boolean; var ANewID, APos: Integer; var AItem: TScBillsItem): Boolean;
+begin
+  Result := False;
+  APos := CheckBillsPastePosition(ABillsQty, ADQQty);
+  case APos of
+    -1: Exit;
+    // 后兄弟无需处理,始终插在选中节点的后兄弟位置。
+    cp_Next: FMajorID := AItem.MajorIndex;
+    cp_Font:
+    begin
+      if AItem.PrevSibling = nil then
+      begin
+        FMajorID := AItem.Parent.MajorIndex;
+        AItem := FBillsData.BillsTree.AddBillsItem(ANewID, AItem.ParentID, AItem.ID);
+        Inc(ANewID);
+        ANew := True;
+      end
+      else
+      begin
+        FMajorID := AItem.PrevNode.MajorIndex;
+        AItem := FBillsData.BillsTree[AItem.PrevSiblingID];
+      end;
+    end;
+    cp_Child:
+    begin
+      {if AItem.HasDrawingQuantity then
+      begin
+        MessageHint(0, '该清单下有图纸工程量,不允许插入子项。');
+        Exit;
+      end;   }
+      if AItem.ChildCount = 0 then
+      begin
+        FMajorID := AItem.MajorIndex;
+        AItem := FBillsData.BillsTree.AddBillsItem(ANewID, AItem.ID, -1);
+        Inc(ANewID);
+        ANew := True;
+      end
+      else
+      begin
+        AItem := TScBillsItem(AItem.LastChild);
+        FMajorID := AItem.MajorIndex;
+      end;
+    end;
+  end;
+  Result := True;
+end;
+
+initialization
+  { The following strings should not be localized }
+  CF_Bills := RegisterClipboardFormat('SmartCost Bills');
+  CF_Rations := RegisterClipboardFormat('SmartCost Rations');
+finalization
+
+
+end.

+ 786 - 0
CU/ScEvaluate.pas

@@ -0,0 +1,786 @@
+unit ScEvaluate;
+
+interface
+
+function Evaluate(formula: string; var status,location: integer) : double; overload;
+function Evaluate(formula: string):double; overload;
+
+implementation
+
+function Evaluate(formula: string):double;
+var
+  iStatus: Integer;
+  iLocation: Integer;
+begin
+  Result := Evaluate(formula, iStatus, iLocation);
+end;
+
+{================================== EVALUATE ================================}
+{ ------------------------------- Declarations ----------------------------- }
+
+const MaxReal = 1.0E+37;       { Maximum real value that we will allow }
+      MaxFact = 33;            { 33! = E+37 }
+      MaxExpo = 85;            { exp(85) = E+37 }
+
+
+
+var   Region,                  { Check if result is defined. eg fact(-1.2) }
+      Divzero,                 { Check if a division by zero occured. eg 1/0 }
+      Overflow,                { Check if result becomes too large. eg 100! }
+      Complex : boolean;       { Check if result is complex. eg sqrt(-1) }
+
+
+{ -------------------------------------------------------------------------- }
+                                                      
+
+{============================================================================}
+{================================== EVALUATE ================================}
+{ From a VERY VERY OLD Pascal 3.0 Function !
+{============================================================================}
+
+
+{ Initialize boolean flags. }
+  procedure Init_Booleans;
+  begin
+    region:=true;              { Result is initially inside region }
+    complex:=false;            { Result is not complex }
+    divzero:=false;            { There is no division by zero }
+    overflow:=false;           { and no overflow. }
+  end;  { Init_Booleans }
+
+
+
+{ Check to see if doing an operation on a and b will cause an overflow and
+  set the OVERFLOW boolean accordingly }
+
+  procedure CheckOverflow(a,b: real; operation: char);
+  begin
+    case operation of
+      '*':  if abs(a) > 1.0 then overflow:=abs(b) > MaxReal/abs(a);
+      '/':  if b <> 0.0 then
+            begin
+              b:=1/b;
+              if abs(a) > 1.0 then overflow:=abs(b) > MaxReal/abs(a)
+            end
+            else overflow:=true;
+      '+':  if b > 0.0 then overflow:=a > (MaxReal - b)
+            else overflow:=a < (-MaxReal - b);
+      '-':  if b < 0.0 then overflow:=a > (MaxReal + b)
+            else overflow:=a < (-MaxReal + b);
+      else overflow:=true;                       { Default for bad operation }
+    end;  { case }
+  end;  { CheckOverflow }
+
+
+{ ----------------------------------------------------------------------------
+   The following functions -- asin,acos,tan,cot,sec,csc,sinh,cosh,tanh,sech,
+   csch,coth,fact -- will default to 0.0 if a division by zero occurs, the
+   result is complex or undefined, or if an overflow occurs.
+
+   If you are using these functions independently of the Evaluate procedure
+   then the procedure Init_Booleans should be called first to reinitialize
+   error checking.
+---------------------------------------------------------------------------- }
+
+
+                             { --- Arc Sine --- }
+
+  function Asin(r: real): real;
+  begin
+    if abs(r) < 1.0 then asin:=arctan(r/sqrt(1-r*r))
+    else
+      if abs(r) = 1.0 then asin:=(r/abs(r))*pi/2
+      else
+      begin
+        asin:=0.0;
+        complex:=true
+      end  { else }
+  end;  { asin }
+
+                            { --- Arc Cosine --- }
+
+  function Acos(r: real): real;
+  begin
+    if r = 0.0 then acos:=pi/2
+    else
+    begin
+      if abs(r) < 1.0 then
+      begin
+        if r < 0.0 then acos:=arctan(sqrt(1-r*r)/r)+pi
+        else acos:=arctan(sqrt(1-r*r)/r)
+      end
+      else
+        if abs(r) = 1.0 then
+          if r = 1.0 then acos:=0.0
+          else acos:=pi
+        else
+        begin
+          acos:=0.0;
+          complex:=true
+        end
+    end
+  end;  { acos }
+
+                             { --- Tangent --- }
+
+  function Tan(r: real): real;
+  begin
+    if cos(r) = 0.0 then
+    begin
+      tan:=0.0;
+      divzero:=true
+    end
+    else tan:=sin(r)/cos(r)
+  end;  { tan }
+
+                            { --- CoTangent --- }
+
+  function Cot(r: real): real;
+  begin
+    if sin(r) = 0.0 then
+    begin
+      cot:=0.0;
+      divzero:=true
+    end
+    else cot:=cos(r)/sin(r)
+  end;  { cot }
+
+                              { --- Secant --- }
+
+  function Sec(r: real): real;
+  begin
+    if cos(r) = 0.0 then
+    begin
+      sec:=0.0;
+      divzero:=true
+    end
+    else sec:=1/cos(r)
+  end;  { Sec }
+
+                            { --- CoSecant --- }
+
+  function Csc(r: real): real;
+  begin
+    if sin(r) = 0.0 then
+    begin
+      csc:=0.0;
+      divzero:=true
+    end
+    else csc:=1/sin(r)
+  end;  { Csc }
+
+                               { --- Sinh --- }
+
+  function Sinh(r: real): real;
+  begin
+    if abs(r) <= MaxExpo then sinh:=(exp(r)-exp(-r))/2
+    else
+    begin
+      overflow:=true;
+      sinh:=0.0
+    end
+  end;  { Sinh }
+
+                             { --- CoSinh --- }
+
+  function Cosh(r: real): real;
+  begin
+    if abs(r) <= MaxExpo then cosh:=(exp(r)+exp(-r))/2
+    else
+    begin
+      overflow:=true;
+      cosh:=0.0
+    end
+  end;  { Cosh }
+
+                               { --- Tanh --- }
+
+  function Tanh(r: real): real;
+  begin
+    if cosh(r) = 0.0 then
+    begin
+      tanh:=0.0;
+      divzero:=true
+    end
+    else
+    begin
+      CheckOverflow(sinh(r),cosh(r),'/');
+      if not overflow then tanh:=sinh(r)/cosh(r)
+      else tanh:=0.0
+    end
+  end;  { Tanh }
+
+                               { --- Sech --- }
+
+  function Sech(r: real): real;
+  begin
+    if cosh(r) = 0.0 then
+    begin
+      sech:=0.0;
+      divzero:=true
+    end
+    else
+    begin
+      CheckOverflow(1,cosh(r),'/');
+      if not overflow then sech:=1/cosh(r)
+      else sech:=0.0
+    end
+  end;  { Sech }
+
+                             { --- CoSech --- }
+
+  function Csch(r: real): real;
+  begin
+    if sinh(r) = 0.0 then
+    begin
+      csch:=0.0;
+      divzero:=true
+    end
+    else
+    begin
+      CheckOverflow(1,sinh(r),'/');
+      if not overflow then csch:=1/sinh(r)
+      else csch:=0.0
+    end
+  end;  { Csch }
+
+                             { --- CoTanh --- }
+
+  function Coth(r: real): real;
+  begin
+    if sinh(r) = 0.0 then
+    begin
+      coth:=0.0;
+      divzero:=true
+    end
+    else
+    begin
+      CheckOverflow(cosh(r),sinh(r),'/');
+      if not overflow then coth:=cosh(r)/sinh(r)
+      else coth:=0.0
+    end
+  end;  { Coth }
+
+                            { --- Factorial --- }
+
+  function Fact(r:real): real;
+  var i: integer;
+      resulta: real;
+  begin
+    if (r < 0.0) or (trunc(r) <> r) then
+    begin
+      resulta:=0.0;
+      region:=false
+    end
+    else
+    begin
+      resulta:=1.0;
+      if trunc(r) < MaxFact then
+        for i:=1 to trunc(r) do
+          resulta:=resulta*i
+      else
+      begin
+        overflow:=true;
+        resulta:=0.0
+      end
+    end;
+    fact:=resulta
+  end;  { Fact }
+
+
+{ ----------------------------------------------------------------------------
+  The function Evaluate is passed a mathematical expression in the form of a
+  string (formula) to be evaluated and returns the following:
+
+  If no errors occur during evaluation then:
+      Result = evaluated expression
+      Status = 0
+      Location = 0
+
+  If an error occurs then:
+      Result = 0.0
+      Status = error type
+      Location = location of error in formula
+
+  Error types:
+   0: No error occured
+   1: Illegal character
+   2: Incorrect syntax
+   3: Illegal or missing parenthese
+   4: Incorrect real format
+   5: Illegal function
+   6: Result is undefined
+   7: Result is too large
+   8: Result is complex
+   9: Division by zero
+
+---------------------------------------------------------------------------- }
+{const
+  ErrStr: array[1..9] of string =
+   ('无效字符',
+    '语法错误',
+    '括号不配对',
+    '实数的格式部正确',
+   );}
+
+
+function Evaluate(formula: string; var status,location: integer):double;
+
+{ ---- Declaration ---- }
+
+const  numbers: set of char = ['0'..'9'];                 { Digits }
+       RightPar: set of char = [')',']','}'];             { Right parentheses }
+       LeftPar: set of char = ['(','[','{'];              { Left parentheses }
+       alpha: set of char = ['A'..'Z'];                   { Alpha characters }
+       operators: set of char = ['+','-','*','/','^'];    { Operators }
+       eofline = ^M;
+
+var ch: char;                                            { Current character }
+    resulto: real;                                        { Final value }
+
+{ ---- Internal routines ---- }
+
+{ Check to see if an error has occured }
+  function Ok: boolean;
+  begin
+    ok:= region and (not divzero) and (not complex)
+         and (not overflow) and (status = 0);
+  end;  { Ok }
+
+{ Get the next character in the string and increment the location pointer. }
+  procedure NextCh;
+  begin
+    repeat
+      location:=location+1;                              { Increment pointer }
+      if location <= length(formula) then ch:=formula[location]
+      else ch:=eofline;
+      if not (ch in alpha + numbers + LeftPar + RightPar + operators
+              + ['%', '.',' ','!',eofline]) then
+        status:=1;                                       { Illegal char. }
+    until ch <> ' ';                                     { Skip blanks }
+  end  { NextCh };
+
+
+{ ---- Nested functions ---- }
+
+
+  function Expression: real;
+  label quit;
+  var e,e_hold: real;
+      opr: char;
+      Leading_Sign,Nested_Function: boolean;
+
+
+    function SimpleExpression: real;
+    label quit;
+    var s,s_hold: real;
+        opr: char;
+
+
+      function Term: real;
+      label quit;
+      var  t,t_hold: real;
+
+
+        function SignedFactor: Real;
+
+
+          function Factor: Real;
+          label quit;
+          type StandardFunction =
+                 (fpi,fabs,fsqrt,fsqr,fln,flog,fexp,ffact,
+                  fsinh,fcosh,ftanh,fsech,fcsch,fcoth,
+                  fsin,fcos,ftan,fsec,fcsc,fcot,fasin,facos,fatan);
+
+               StandardFunctionList = array[StandardFunction] of string[4];
+
+           const StandardFunctionNames: StandardFunctionList =
+                  ('PI','ABS','SQRT','SQR','LNG','LOG','EXP','FACT',
+                   'SINH','COSH','TANH','SECH','CSCH','COTH',
+                   'SIN','COS','TAN','SEC','CSC','COT','ASIN','ACOS','ATAN');
+
+           var Found: Boolean;
+               l: integer;
+               F: Real;
+               str: string;
+               Sf: StandardFunction;
+               start,position: integer;
+
+          begin { Function Factor }
+
+          { Exit if error }
+            if not ok then begin f:=0.0; goto quit end;
+
+          { Get a real or integer expression }
+            if ch in numbers+['.'] then
+            begin
+              start:=location;
+              if ch in numbers then repeat NextCh until not (ch in numbers);
+              if ch = '.' then repeat NextCh until not (ch in numbers);
+
+            { Get the E format of a real expression }
+              if ch = 'E' then
+              begin
+                NextCh;
+                if ch = 'X' then location:=location - 1      { Skip EXP(...) }
+                else
+                  if not (ch in numbers + ['+','-']) then status:=4
+                  else repeat NextCh until not (ch in numbers);
+              end;
+
+            { Check the real format }
+              str:=copy(formula,start,location-start);
+
+              { Remove all spaces in str otherwise val will bomb! }
+              while pos(' ',str) <> 0 do delete(str,pos(' ',str),1);
+
+              val(str,f,position);
+              if position <> 0 then
+              begin
+                location:=start+position;
+                status:=4                            { Incorrect Real format }
+              end;
+
+              if Ok and (Ch = '%') then
+              begin
+                f := f / 100;
+                NextCh;
+              end;
+            end    { end if ch in number }
+
+          { The character is not a digit }
+            else
+            begin
+
+            { Check for for the beginning of a "sub" expression }
+              if ch in LeftPar then
+              begin
+                NextCh;
+                F:=Expression;                       { RECURSION !!! }
+                if ok and (ch in RightPar) then      { Check for implicit * }
+                begin
+                  NextCh;
+                  if not (ch in operators+LeftPar+RightPar+['!',eofline]) then
+                  begin
+                    ch:='*';
+                    location:=location-1
+                  end;
+                end
+                else status:=3                         { Illegal parenthese }
+              end  { if ch in LeftPar }
+
+            { It should be a function }
+              else
+              begin
+                found:=false;
+
+              { Search for the function among our list }
+                for sf:=fpi to fatan do
+                  if not found then
+                  begin
+                    l:=length(StandardFunctionNames[sf]);
+
+                    if copy(formula,location,l)=StandardFunctionNames[sf] then
+                    begin
+                      location:=location+l-1;
+                      NextCh;
+                      if sf <> fpi then
+                      begin
+                        Nested_Function:=true;
+                        F:=Factor
+                      end;
+
+                    { Assign values according to the function }
+                      case sf of
+                        fpi:      f:=pi;                  { pi is predefined }
+                        fsqr:     if f < 1.0e+19 then f:=sqr(f)
+                                  else
+                                  begin
+                                    f:=0.0;
+                                    overflow:=true
+                                  end;
+                        fabs:     f:=abs(f);
+                        fsqrt:    if f < 0.0 then
+                                  begin
+                                    complex:=true;
+                                    f:=0.0
+                                  end
+                                  else f:=sqrt(f);
+
+                        fsin:     f:=sin(f);
+                        fcos:     f:=cos(f);
+                        ftan:     f:=tan(f);
+                        fasin:    f:=asin(f);
+                        facos:    f:=acos(f);
+                        fatan:    f:=arctan(f);
+                        fsec:     f:=sec(f);
+                        fcsc:     f:=csc(f);
+                        fcot:     f:=cot(f);
+
+                        fsinh:    f:=sinh(f);
+                        fcosh:    f:=cosh(f);
+                        ftanh:    f:=tanh(f);
+                        fsech:    f:=sech(f);
+                        fcsch:    f:=csch(f);
+                        fcoth:    f:=coth(f);
+
+                        fexp:     if abs(f) < MaxExpo then f:=exp(f)
+                                  else
+                                    if f < 0 then f:=0.0
+                                    else
+                                    begin
+                                      overflow:=true;
+                                      f:=0.0
+                                    end;
+                        ffact:    f:=fact(f);
+                        fln :     if f < 0.0 then
+                                  begin
+                                    complex:=true;
+                                    f:=0.0
+                                  end
+                                  else
+                                    if f = 0.0 then
+                                    begin
+                                      overflow:=true;
+                                      f:=0.0
+                                    end
+                                    else f:=ln(f);
+                        flog:     if f < 0.0 then
+                                  begin
+                                    complex:=true;
+                                    f:=0.0
+                                  end
+                                  else
+                                    if f = 0.0 then
+                                    begin
+                                      overflow:=true;
+                                      f:=0.0
+                                    end
+                                    else f:=ln(f)/ln(10);
+                      end; { Case }
+
+                      found:=true;
+                      Nested_Function:=false;
+
+                    { Check for a trailing factorial symbol }
+                      if ch = '!' then
+                      begin
+                        f:=fact(f);
+                        NextCh
+                      end
+
+                    end   { If copy = function }
+                  end;  { If not found }
+
+              { Check for more errors }
+                if (not found) and ok and not (ch in alpha) then
+                  status:=2;                                  { Illegal Syntax }
+                if (not found) and ok and (ch in alpha) then
+                  status:=5;                                { Illegal function }
+
+              end  { Else not ch in LeftPar .. ie. it should be a function }
+            end; { else the character is not a digit }
+
+          { Check for a trailing factorial symbol }
+            if ok and (not Nested_Function) and (ch = '!') then
+            begin
+              f:=fact(f);
+              NextCh
+            end;
+
+          { Assign final value }
+     quit:  Factor:=F
+          end;  { Factor inside SignedFactor }
+
+        begin  { SignedFactor }
+          if ch = '-' then
+          begin
+            NextCh;
+            SignedFactor:= -Factor
+          end
+          else SignedFactor:=Factor;
+        end  { SignedFactor inside Term };
+
+
+      begin { Term }
+        if not ok then begin t:=0.0; goto quit end;          { Exit }
+
+        t:=SignedFactor;
+        while ch = '^' do
+        begin
+          if not ok then begin t:=0.0; goto quit end;        { Exit }
+
+          NextCh;
+          t_hold:=SignedFactor;
+
+        { Check for illegal power }
+          if ((t < 0.0) and ((t_hold-trunc(t_hold)) <> 0.0)) or (t = 0.0) then
+          begin
+            t:=0.0;
+            complex:=true
+          end
+
+        { Power is legal }
+          else
+          begin
+            if t < 0.0 then
+            begin
+              CheckOverflow(ln(-t),t_hold,'*');
+              if not Ok then begin t:=0.0; goto quit end;     { Exit }
+
+              if ln(-t)*t_hold <= MaxExpo then
+                case trunc(abs(t_hold)) mod 2 = 0 of
+                  true:  t:=exp(ln(-t)*t_hold);
+                  false: t:=-exp(ln(-t)*t_hold)
+                end
+              else
+              begin
+                t:=0.0;
+                overflow:=true
+              end
+            end  { if t < 0.0 }
+
+            else  { t >= 0.0 }
+            begin
+              CheckOverflow(ln(t),t_hold,'*');
+              if not Ok then begin t:=0.0; goto quit end;     { Exit }
+
+              if ln(t)*t_hold <= MaxExpo then t:=exp(ln(t)*t_hold)
+              else
+              begin
+                t:=0.0;
+                overflow:=true
+              end
+            end  { else t >= 0.0 }
+          end  { else not illegal power }
+        end;  { while }
+  quit: Term:=t;
+      end;  { Term inside SimpleExpression }
+
+
+    begin { SimpleExpression }
+      if not ok then begin s:=0.0; goto quit end;                     { Exit }
+      s:=term;
+
+    { Check for implicit multiplication and insert missing "*" }
+      if ok and (ch in LeftPar + alpha + numbers + ['.']) then
+      begin
+        ch:='*';
+        location:=location-1
+      end;
+
+      while ch in ['*','/'] do
+      begin
+        if not ok then begin s:=0.0; goto quit end;                    { Exit }
+        opr:=ch;
+        NextCh;
+
+      { Check for implicit multiplication and insert missing "*" }
+        if opr in LeftPar + alpha + numbers + ['.'] then
+        begin
+          opr:='*';
+          ch:='(';
+          location:=location-1
+        end;
+
+        s_hold:=term;
+        case opr of
+          '*': begin
+                 CheckOverflow(s,s_hold,'*');
+                 if not overflow then s:=s*s_hold
+                 else s:=0.0
+               end;
+          '/': begin
+                 divzero:=s_hold = 0.0;
+                 if not divzero then
+                 begin
+                   CheckOverflow(s,s_hold,'/');
+                   if not overflow then s:=s/s_hold
+                   else s:=0.0
+                 end
+                 else s:=0.0
+               end
+        end;  { Case }
+
+      { Check for implicit multiplication and insert missing "*" }
+        if ok and (ch in LeftPar + alpha + numbers + ['.']) then
+        begin
+          ch:='*';
+          location:=location-1
+        end
+      end;  { while }
+
+    { Assign final value }
+quit: SimpleExpression:=s;
+    end;  { SimpleExpression inside Expression }
+
+
+  begin { Expression }
+    if not ok then begin e:=0.0; goto quit end;                       { Exit }
+    Nested_Function:=false;
+
+    Leading_Sign:= ch = '-';                              { The default is + }
+    if ch in ['+','-'] then Nextch;                      { Skip leading sign }
+    case Leading_Sign of                              { Set for leading sign }
+      true:   e:= -SimpleExpression;
+      false:  e:= SimpleExpression
+    end;
+
+    while ch in ['+','-'] do
+    begin
+      if not ok then begin e:=0.0; goto quit end;                     { Exit }
+      opr:=ch;
+      NextCh;
+
+      e_hold:=SimpleExpression;
+      case opr of
+        '+': begin
+               CheckOverflow(e,e_hold,'+');
+               if not overflow then e:=e+e_hold
+               else e:=0.0;
+             end;
+        '-': begin
+               CheckOverflow(e,e_hold,'-');
+               if not overflow then e:=e-e_hold
+               else e:=0.0;
+             end;
+      end;  { case }
+    end;  { while }
+  quit: Expression:=e;
+  end; { Expression inside Evaluate }
+
+var i:integer;
+
+begin { Evaluate }
+
+{ Initialize }
+  for i:=1 to length(formula) do
+     formula[i]:=upcase(formula[i]);
+  Init_Booleans;
+  status:=0;
+  location:=0;
+  NextCh;
+
+{ Get result }
+  resulto:=Expression;
+
+{ Check for final errors }
+  if ok then if ch <> eofline then status:=2;             { Incorrect Syntax }
+
+  if not region then status:=6;
+  if overflow then status:=7;
+  if complex then status:=8;
+  if divzero then status:=9;
+
+  if status in [4,6..9] then location:=location-1;
+  if status = 0 then location:=0
+  else resulto:=0.0;
+
+  Evaluate:=resulto;
+end { Evaluate };
+
+
+
+
+end.
+ 

Разница между файлами не показана из-за своего большого размера
+ 2348 - 0
CU/ScFileArchiver.pas


+ 417 - 0
CU/ScFileProviders.pas

@@ -0,0 +1,417 @@
+unit ScFileProviders;
+
+interface
+
+uses
+  Windows, Classes, SysUtils, ConstMethodUnit, ADODB, ScFileArchiver, Forms;
+
+type
+  EScFileProvider = class(Exception);
+
+  TScConnection = class(TObject)
+  private
+    FRefCount: Integer;
+//    FFileName: string;
+    FConnection: TADOConnection;
+    FFileArchiver: TScMDBArchiver;
+    FIsNew: Boolean;
+    FID: Integer;
+    function GetFileName: string;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    property ID: Integer read FID;
+    property RefCount: Integer read FRefCount;
+    property Connection: TADOConnection read FConnection;
+    property FileName: string read GetFileName;
+    property FileArchiver: TScMDBArchiver read FFileArchiver;
+    property IsNew: Boolean read FIsNew;
+  end;
+
+  TScFileType = (ftProject, ftRationLib, ftFeeRate, ftUnitPrice);
+
+  TScArchiverClass = class of TScMDBArchiver;
+
+  TScFileProvider = class(TObject)
+  private
+    FConnections: TList;
+    FFileType: TScFileType;
+    FTemplateFileName: string;
+    function GetArchiverClass: TScArchiverClass;
+    function GetConnection(ID: Integer): TScConnection;
+    function AddConnection(AFileName: string): TScConnection;
+    function FindConnection(AFileName: string): TScConnection;
+    procedure SetFileType(const Value: TScFileType);
+    procedure SetTemplateFileName(const Value: string);
+    procedure Clear;
+    function GetNewID: Integer;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    function New: Integer;
+    function Open(AFileName: string): Integer;
+    function Close(AFileName: string): Boolean; overload;
+    function Close(AID: Integer): Boolean; overload;
+    function Save(AFileName: string): Boolean; overload;
+    function Save(AID: Integer): Boolean; overload;
+    function SaveAs(AFileName: string; ANewFileName: string): Boolean; overload;
+    function SaveAs(AID: Integer; ANewFileName: string): Boolean; overload;
+    function Refresh(AID: Integer): Boolean; overload;
+    function Refresh(AFileName: string): Boolean; overload;
+    function IndexByName(AFileName: string): TScConnection;
+    property Connection[ID: Integer]: TScConnection read GetConnection;
+    property FileType: TScFileType read FFileType write SetFileType;
+    property TemplateFileName: string read FTemplateFileName write SetTemplateFileName;
+  end;
+
+var
+  ProjProvider: TScFileProvider;
+  FeeRateProvider: TScFileProvider;
+  UnitPriceProvider: TScFileProvider;
+
+implementation
+
+uses
+  ScConfig;
+
+{ TScConnection }
+
+constructor TScConnection.Create;
+begin
+  FRefCount := 0;
+//  FFileName := '';
+  FConnection := nil;
+  FFileArchiver := nil;
+  FIsNew := False;
+end;
+
+destructor TScConnection.Destroy;
+begin
+
+  inherited;
+end;
+
+function TScConnection.GetFileName: string;
+begin
+  if FFileArchiver <> nil then
+    Result := FFileArchiver.FileName;
+end;
+
+{ TScFileProvider }
+
+function TScFileProvider.AddConnection(AFileName: string): TScConnection;
+begin
+  Result := nil;
+  Result := TScConnection.Create;
+  Result.FConnection := TADOConnection.Create(nil);
+  Result.FFileArchiver := GetArchiverClass.Create;
+  Result.FFileArchiver.Connection := Result.FConnection;
+  Result.FFileArchiver.FileName := AFileName;
+  try
+    if not Result.FFileArchiver.OpenFile then
+    begin
+      FreeAndNil(Result);
+      Exit;
+    end;
+  except
+    Result := nil;
+    MessageError(0, Format('无法打开文件[%s]!', [AFilename]));
+  end;
+  if Result <> nil then
+  begin
+    FConnections.Add(Result);
+    Result.FID := GetNewID + 1;
+    Inc(Result.FRefCount);
+  end;
+end;
+
+function TScFileProvider.Close(AFileName: string): Boolean;
+var
+  Con: TScConnection;
+begin
+  Result := True;
+  Con := FindConnection(AFileName);
+  if Con <> nil then
+  begin
+    if Con.RefCount > 1 then
+      Dec(Con.FRefCount)
+    else
+    begin
+      FConnections.Remove(Con);
+      Con.FileArchiver.CloseFile;
+      Con.Connection.Connected := False;
+      Con.Connection.Free;
+      Con.FileArchiver.Free;
+      Con.Free;
+    end;
+  end;
+end;
+
+function TScFileProvider.Close(AID: Integer): Boolean;
+var
+  Con: TScConnection;
+begin
+  Result := True;
+  Con := Connection[AID];
+  if Con <> nil then
+  begin
+    if Con.RefCount > 1 then
+      Dec(Con.FRefCount)
+    else
+    begin
+      FConnections.Remove(Con);
+      Con.FileArchiver.CloseFile;
+      Con.Connection.Connected := False;
+      Con.Connection.Free;
+      Con.FileArchiver.Free;
+      Con.Free;
+    end;
+  end;
+end;
+
+constructor TScFileProvider.Create;
+begin
+  FConnections := TList.Create;
+end;
+
+destructor TScFileProvider.Destroy;
+begin
+  Clear;
+  FConnections.Free;
+  inherited;
+end;
+
+function TScFileProvider.FindConnection(AFileName: string): TScConnection;
+var
+  I: Integer;
+begin
+  Result := nil;
+  for I := 0 to FConnections.Count - 1 do
+  begin
+    if SameText(AFileName, TScConnection(FConnections[I]).FileName) then
+    begin
+      Result := TScConnection(FConnections[I]);
+      Break;
+    end;
+  end;
+end;
+
+function TScFileProvider.GetConnection(ID: Integer): TScConnection;
+var
+  I: Integer;
+begin
+  Result := nil;
+  for I := 0 to FConnections.Count - 1 do
+  begin
+    if ID = TScConnection(FConnections[I]).FID then
+    begin
+      Result := TScConnection(FConnections[I]);
+      Break;
+    end;
+  end;
+end;
+// 这方法不行,如果某个文件被关闭了,会从List中删除,这时会有错误。
+{begin
+  Result := nil;
+  if (ID >= 0) and (ID < FConnections.Count) then
+  begin
+    Result := TScConnection(FConnections.Items[ID]);
+    if not (Result is TScConnection) then
+      Result := nil;
+  end
+  else
+    Result := nil;
+end;}
+
+function TScFileProvider.Open(AFileName: string): Integer;
+var
+  Con: TScConnection;
+begin
+  Result := -1;
+  Con := FindConnection(AFileName);
+  if Con = nil then
+  begin
+    Con := AddConnection(AFileName);
+    if Con = nil then
+    begin
+      Result := -1;
+      Exit;
+    end;
+    Con.Connection.LoginPrompt := False;
+    Con.Connection.Connected := True;
+  end
+  else
+    Inc(Con.FRefCount);
+  Result := Con.ID;
+end;
+
+function TScFileProvider.Save(AFileName: string): Boolean;
+var
+  Con: TScConnection;
+begin
+  Result := False;
+  Con := FindConnection(AFileName);
+  if Con <> nil then
+  begin
+    Result := Con.FileArchiver.Save;
+  end;
+end;
+
+function TScFileProvider.Save(AID: Integer): Boolean;
+var
+  Con: TScConnection;
+begin
+  Result := False;
+  Con := Connection[AID];
+  if Con <> nil then
+  begin
+    Result := Con.FileArchiver.Save;
+  end;
+end;
+
+function TScFileProvider.SaveAs(AFileName: string;
+  ANewFileName: string): Boolean;
+var
+  Con: TScConnection;
+begin
+  Result := False;
+  Con := FindConnection(AFileName);
+  if Con <> nil then
+  begin
+    Result := Con.FileArchiver.SaveTo(ANewFileName);
+  end;
+end;
+
+function TScFileProvider.SaveAs(AID: Integer;
+  ANewFileName: string): Boolean;
+var
+  Con: TScConnection;
+begin
+  Result := False;
+  Con := Connection[AID];
+  if Con <> nil then
+  begin
+    Result := Con.FileArchiver.SaveTo(ANewFileName);
+  end;
+end;
+
+procedure TScFileProvider.SetFileType(const Value: TScFileType);
+begin
+  FFileType := Value;
+end;
+
+function TScFileProvider.GetArchiverClass: TScArchiverClass;
+begin
+  Result := TScMDBArchiver;
+  case FFileType of
+    ftProject:
+      Result := TScProjectFileArchiver;
+    ftRationLib:
+      Result := TScRationLibArchiver;
+    ftFeeRate:
+      Result := TScFeeRateFileArchiver;
+    ftUnitPrice:
+      Result := TScUnitPriceFileArchiver;
+  end;
+end;
+
+function TScFileProvider.New: Integer;
+var
+  Con: TScConnection;
+begin
+  Result := -1;
+  if not FileExists(FTemplateFileName) then
+  begin
+    raise EScFileProvider.Create('文件系统故障,无法创建新文件!');
+  end;
+  Con := AddConnection(FTemplateFileName);
+  Con.Connection.LoginPrompt := False;
+  Con.Connection.Connected := True;
+  Result := Con.ID;
+end;
+
+procedure TScFileProvider.SetTemplateFileName(const Value: string);
+begin
+  FTemplateFileName := Value;
+end;
+
+procedure TScFileProvider.Clear;
+var
+  I: Integer;
+  Con: TScConnection;
+begin
+  for I := 0 to FConnections.Count - 1 do
+  begin
+    Con := TScConnection(FConnections[I]);
+    if Con <> nil then
+    begin
+      Con.FileArchiver.CloseFile;
+      Con.Connection.Connected := False;
+      Con.Connection.Free;
+      Con.FileArchiver.Free;
+      Con.Free;
+    end;
+  end;
+  FConnections.Clear;
+end;
+
+function TScFileProvider.IndexByName(AFileName: string): TScConnection;
+begin
+  Result := FindConnection(AFileName);
+end;
+
+function TScFileProvider.Refresh(AID: Integer): Boolean;
+var
+  Con: TScConnection;
+begin
+  Result := False;
+  Con := Connection[AID];
+  if Con <> nil then
+  begin
+    Result := Con.FileArchiver.Refresh;
+  end;
+end;
+
+function TScFileProvider.Refresh(AFileName: string): Boolean;
+var
+  Con: TScConnection;
+begin
+  Result := False;
+  Con := FindConnection(AFileName);
+  if Con <> nil then
+  begin
+    Result := Con.FileArchiver.Refresh;
+  end;
+end;
+
+function TScFileProvider.GetNewID: Integer;
+var
+  I, iMaxID: Integer;
+begin
+  iMaxID := 0;
+  for I := 0 to FConnections.Count - 1 do
+  begin
+    if iMaxID < TScConnection(FConnections[I]).ID then
+      iMaxID := TScConnection(FConnections[I]).ID;
+  end;
+  Result := iMaxID;
+end;
+
+initialization
+  ProjProvider := TScFileProvider.Create;
+  ProjProvider.FFileType := ftProject;
+//  这里ConfigInfo还没有加载,不行
+//  ProjProvider.TemplateFileName := ConfigInfo.ProjFileTemplate;//ExtractFilePath(Application.ExeName) + 'Data\MainTemplate.dat';
+
+  FeeRateProvider := TScFileProvider.Create;
+  FeeRateProvider.FFileType := ftFeeRate;
+
+  UnitPriceProvider := TScFileProvider.Create;
+  UnitPriceProvider.FFileType := ftUnitPrice;
+
+finalization
+  ProjProvider.Free;
+  FeeRateProvider.Free;
+  UnitPriceProvider.Free;
+
+end.

Разница между файлами не показана из-за своего большого размера
+ 2723 - 0
CU/ScKindsOfTrees.pas


+ 827 - 0
CU/ScProjectManager.pas

@@ -0,0 +1,827 @@
+unit ScProjectManager;
+
+interface
+
+uses
+  DataBase,
+  Classes,
+  ScFileArchiver,
+  ConstTypeUnit,
+  Windows,
+  BillsProjectFrame,
+  ConstVarUnit,
+  ScUpdateDataBase,
+  Forms,
+  Variants,
+  HisRestorePointDM,
+  ScExprsDM,
+  ProjectPropertyDM,
+  ImportExcel,
+  ADODB,
+  DetailItemsDM,
+  ExportExcel,
+  ScReportDM,
+  RecycleBinDM;
+
+type
+  TProject = class
+  private
+    FID             : Integer;
+    FFlag           : Integer;
+    FParentID       : Integer;
+    FNavigation     : Integer;
+    FFilePath       : string;
+    FProjectName    : string;
+    FChanged        : Boolean;
+    FDMExprs        : TDMExprs;
+    FStdBillsCtrl   : TObject;
+    FBillsData      : TDMDataBase;
+    FProjPropertyDM : TProjPropertyDM;
+    FRecycleBinData : TRecycleBinData;
+    FDMHisPoint     : TDMHisRestorePoint;
+    FProjectView    : TBillsProjectView;
+    FDetailItemsDM  : TDMDetailItems;
+    FArchiver       : TScProjectFileArchiver;
+    // chenshilong, 2011-01-13 11:23:05
+    FReport         : TReportData;
+    FOpenForReport  : Boolean;
+    // 显示报表前要修改SerialNo,用完后会提示项目保存,加个条件不让提示
+    FChangedByReport: Boolean;
+    // 强制不保存。如新建项目后关闭,预览报表后关闭。
+    FForceUndoSave: Boolean;
+
+    procedure SetStdBillsCtrl(const Value: TObject);
+    function NewFile(const aFileName, TempleteFile: string; var aNewName: string): Boolean;
+    { save project }
+    procedure InnerSave;
+    procedure Save; overload;
+    procedure InitNewProject;
+    function GetProjectType: Integer;
+    procedure SetProjectName(const Value: string);
+    function GetConnection: TADOConnection;
+    procedure SetBidLotList(const Value: TStrings);
+    procedure SetFlag(const Value: Integer);
+  public
+    constructor Create(const FileName, aShortName: string; ProjectType, aID: Integer);
+    destructor Destroy; override;
+
+    procedure Save(const aCreatePoint: Boolean; aFixed: Boolean = False); overload;
+    procedure SaveAs(const FileName: string);
+    // Added by GiLi 2012-3-16 17:17:36
+    // 重新设置文件的别名
+    procedure ResetFileAlias(const sNewAlias: string);
+    function NeedSaveDatabase: Boolean;
+
+    { gather project }
+    procedure CheckBeforeGather;
+    function GetGatherID: Integer;
+    function GatherProject(ANewProject: TProject): Boolean;
+    { import excel file }
+    procedure ImportExcelFile(const aFileName: string);
+    procedure ImportQtyItems(const aFileName: string);
+    procedure ExportExcel(aProjMgr: TObject; const aFileName: string; aStrings: TStrings; aFlag: Integer);
+    procedure ExportFlatExcel(const AFileName: string);
+
+    { 1. File Manager }
+    property ID: Integer read FID;
+    // Flag=1 : 建设项目  Flag=2 : 标段  Flag=3 : 项目清单
+    property Flag: Integer read FFlag write SetFlag;
+    property ParentID: Integer read FParentID write FParentID;
+    property BidLotList: TStrings write SetBidLotList;
+    { 2. Active Objects }
+    property BillsData: TDMDataBase read FBillsData;
+    property ProjPropertyDM: TProjPropertyDM read FProjPropertyDM;
+    property DMHisPoint: TDMHisRestorePoint read FDMHisPoint;
+    property ProjectView: TBillsProjectView read FProjectView;
+    property StdBillsCtrl: TObject read FStdBillsCtrl write SetStdBillsCtrl;
+    property DetailItemsDM: TDMDetailItems read FDetailItemsDM;
+    property RecycleBinData: TRecycleBinData read FRecycleBinData;
+    { 3. Connection }
+    property Connection: TADOConnection read GetConnection;
+    property Archiver: TScProjectFileArchiver read FArchiver;
+    { 4. project Base Property }
+    property Changed: Boolean read FChanged write FChanged;
+    property FilePath: string read FFilePath write FFilePath;
+    property ProjectName: string read FProjectName write SetProjectName;
+    property ProjectType: Integer read GetProjectType;
+    property Navigation: Integer read FNavigation write FNavigation;
+    property Report: TReportData read FReport write FReport;
+    property OpenForReport: Boolean read FOpenForReport write FOpenForReport;
+    property ChangedByReport: Boolean read FChangedByReport write FChangedByReport;
+    property ForceUndoSave: Boolean read FForceUndoSave write FForceUndoSave;
+  end;
+
+  TProjectManager = class
+  private
+    FProjectList: TList;
+    FProjType: TScProjType;
+    FActiveIndex: Integer;
+    FActiveProject: TProject;
+    function FindProject(const AIdx: Integer): TProject;
+    function GetProjectCount: Integer;
+    function GetProject(Idx: Integer): TProject;
+    procedure SaveAllProjects(const aCreatePoint: Boolean);
+    procedure SaveCurProject(const aCreatePoint: Boolean);
+  public
+    constructor Create;
+    destructor Destroy; override;
+    {open or create new project}
+    function CreateNewProject(const FileName, aShortName: string; AStdBillsCtrl: TObject;
+      AProjectType, aID: Integer): TProject;
+
+    {find project by index}
+    function LocateProject(const AIdx: Integer): Boolean;
+    {remove project}
+    function RemoveProject(Project: TProject = nil; AProject: TProject = nil; IsExist: Boolean = True): Integer;
+    function RemoveProjectForClose(var CanColse: Boolean; Project: TProject = nil; AProject: TProject = nil; IsExist: Boolean = True): Integer;
+    {save projects}
+    procedure SaveProjects(const aSaveAll, aCreatePoint: Boolean);
+    {find project by name}
+    function CheckProjectExists(const AFileName: string): Integer;
+
+    procedure ResetAllOpenProjectView;
+
+    property Projects[Idx: Integer]: TProject read GetProject;
+    property ProjectCount: Integer read GetProjectCount;
+    property ActiveProject: TProject read FActiveProject;
+    property ActiveIndex: Integer read FActiveIndex;
+    property ProjectList: TList read FProjectList write FProjectList;
+    // chenshilong, 2011-01-12 16:09:00
+    // 为预览报表打开创建汇总项目
+    function OpenProjectForReport(AFileName: string): TProject;
+    // 关闭为预览报表而打开创建的汇总项目
+    procedure CloseProjectsForReport;
+
+    procedure SetReportsFirstGetData;
+    function GetProjectByID(AID: Integer): TProject;
+  end;
+
+implementation
+
+uses
+  SysUtils,
+  ConstMethodUnit,
+  ScKindsOfTrees,
+  ZjIDTree,
+  ExportDecorateUnit,
+  SMCells,
+  SMXLS, MainForm, ProjectManagerDM, ScProgressFrm;
+
+{ TProjectManager }
+
+function TProjectManager.CheckProjectExists(
+  const AFileName: string): Integer;
+var
+  I: Integer;
+  project: TProject;
+begin
+  Result := -1;
+  for I := 0 to FProjectList.Count - 1 do
+  begin
+    project := TProject(FProjectList.List^[I]);
+    if SameText(AFileName, project.FilePath) then
+    begin
+      Result := I;
+      Break;
+    end;
+  end;
+end;
+
+constructor TProjectManager.Create;
+begin
+  FProjectList := TList.Create;
+  {$IFDEF _ScBills}
+  FProjType := ptBills;
+  {$ELSE}
+  FProjType := ptBudget;
+  {$ENDIF}
+end;
+
+function TProjectManager.CreateNewProject(const FileName, aShortName: string;
+  AStdBillsCtrl: TObject; AProjectType, aID: Integer): TProject;
+var
+  strName: string;
+begin
+  case FProjType of
+    ptBills:
+      strName := BillsTemplateFile;
+    ptBudget:
+      strName := BudgetTemplateFile;
+  end;
+  Result := TProject.Create(FileName, aShortName, AProjectType, aID);
+  Result.StdBillsCtrl := AStdBillsCtrl;
+  FActiveIndex := FProjectList.Add(Result);
+  FActiveProject := Result;
+end;
+
+procedure TProjectManager.CloseProjectsForReport;
+var
+  I: Integer;
+  vProject: TProject;
+begin
+  for I := FProjectList.Count - 1 downto 0 do
+  begin
+    vProject := TProject(FProjectList[I]);
+    if vProject.OpenForReport then
+    begin
+      vProject.Free;
+      FProjectList.Delete(I);
+    end;
+  end;
+end;
+
+destructor TProjectManager.Destroy;
+var
+  I: Integer;
+  project: TProject;
+begin
+  for I := FProjectList.Count - 1 downto 0 do
+  begin
+    project := TProject(FProjectList[I]);
+    if MainFrm.IsSave then
+    begin
+      if project.NeedSaveDatabase then
+      begin
+        if MessageBox(0, PChar(Format('项目[%s]已被修改, 是否保存项目?', [project.ProjectName])),
+          PChar('询问'), MB_YESNO or MB_ICONQUESTION or MB_TOPMOST) = IDYES then
+          project.Save;
+      end;
+    end;
+    project.Free;
+  end;
+  FProjectList.Free;
+  inherited;
+end;
+
+function TProjectManager.FindProject(const AIdx: Integer): TProject;
+begin
+  if (AIdx > -1) and (AIdx < FProjectList.Count) then
+    Result := TProject(FProjectList[AIdx])
+  else Result := nil;
+end;
+
+function TProjectManager.GetProject(Idx: Integer): TProject;
+begin
+  if (Idx >= 0) and (Idx < FProjectList.Count) then
+    Result := TProject(FProjectList.List^[Idx])
+  else Result := nil;
+end;
+
+function TProjectManager.GetProjectCount: Integer;
+begin
+  Result := FProjectList.Count;
+end;
+
+function TProjectManager.LocateProject(const AIdx: Integer): Boolean;
+var
+  Project: TProject;
+begin
+  Project := FindProject(AIdx);
+  if Assigned(Project) then
+  begin
+    FActiveProject := Project;
+    FActiveIndex := AIdx;
+    Result := True;
+  end
+  else
+  begin
+    Result := False;
+    FActiveIndex := -1;
+  end;
+end;
+
+function TProjectManager.OpenProjectForReport(AFileName: string): TProject;
+var vArchiver: TScProjectFileArchiver;
+  iIdx, ProID: Integer;
+  sName, ProName: string;
+  aqExec: TADOQuery;
+begin
+  if not FileExists(AFileName) then
+  begin
+    Result := nil;
+    Exit;
+  end;
+
+  vArchiver := nil;
+
+  iIdx := CheckProjectExists(AFileName);
+  if iIdx = -1 then
+  begin
+    CreateProgressForm(100);
+    AddProgressForm(20, '汇总项目尚末打开,正在从后台打开……');
+    try
+      vArchiver := TScProjectFileArchiver.Create;
+      vArchiver.FileName := AFileName;
+      vArchiver.OpenFile;
+
+      sName := ExtractFileName(AFileName);
+      sName := Copy(sName, 1, Length(sName) - 4);
+
+      with MainFrm.ProjectFileManager.ProjectMgrDM do
+      begin
+        aqExec := TADOQuery.Create(nil);
+        try
+          aqExec.Connection := aqGatherBid.Connection;
+          aqExec.SQL.Add(Format('Select * from ProjectManager where Flag = 3 and UnKnowName = ''%s''', [sName]));
+          aqExec.Open;
+          if aqExec.RecordCount > 0 then
+          begin
+            ProID := aqExec.FieldByName('ID').AsInteger;
+            ProName := aqExec.FieldByName('ProjectName').AsString;
+          end
+          else
+          begin
+            Result := nil;
+            Exit;
+          end;
+        finally
+          aqExec.Free;
+        end;
+      end;
+
+      Result := TProject.Create(AFileName, ProName, -1, ProID);
+      Result.OpenForReport := True;
+      FProjectList.Add(Result);
+      Result.BillsData.Connection := vArchiver.Connection;
+      UpdateDB(vArchiver);
+      vArchiver.Save;
+      Result.BillsData.Active := True;
+      Result.BillsData.ConnectionBillsTree;
+      Result.Report.RefreshData;
+    finally
+      CloseProgressForm;
+    end;
+  end
+  else
+  begin
+    Result := Projects[iIdx];
+    Result.Report.RefreshData;
+  end;
+
+  if Assigned(vArchiver) then
+    vArchiver.Free;
+end;
+
+function TProjectManager.RemoveProject(Project: TProject; AProject: TProject; IsExist: Boolean): Integer;
+var
+  curProject: TProject;
+begin
+  curProject := Project;
+  if Assigned(Project) then Result := FProjectList.Remove(Project)
+  else
+  begin
+    curProject := FActiveProject;
+    Result := FProjectList.Remove(FActiveProject);
+  end;
+
+  if Assigned(curProject) then
+  begin
+    if curProject.NeedSaveDatabase then
+    begin
+      if IsExist then
+      begin
+        if MessageBox(0, PChar(Format('项目 [%s] 已被修改,是否保存?', [curProject.ProjectName])),
+          PChar('询问'), MB_YESNO or MB_TOPMOST or MB_ICONQUESTION) = IDYES then
+          curProject.Save(True);
+      end
+      else
+        curProject.Save(True);
+    end;
+    
+    curProject.Free;
+  end;
+
+  if Assigned(AProject) then FActiveProject := AProject
+  else
+  begin
+    if FProjectList.Count = 0 then FActiveProject := nil
+    else if Result < FProjectList.Count then
+      FActiveProject := TProject(FProjectList[Result])
+    else FActiveProject := TProject(FProjectList[Result - 1]);
+  end;
+
+  FActiveIndex := FProjectList.IndexOf(FActiveProject);
+end;
+
+procedure TProjectManager.SaveAllProjects(const aCreatePoint: Boolean);
+var
+  I: Integer;
+  project: TProject;
+begin
+  for I := 0 to FProjectList.Count - 1 do
+  begin
+    project := TProject(FProjectList.List^[I]);
+    if project.NeedSaveDatabase then project.Save(aCreatePoint);
+  end;
+end;
+
+procedure TProjectManager.SaveCurProject(const aCreatePoint: Boolean);
+begin
+  if Assigned(FActiveProject) and FActiveProject.NeedSaveDatabase then
+    FActiveProject.Save(aCreatePoint);
+end;
+
+procedure TProjectManager.SaveProjects(const aSaveAll, aCreatePoint: Boolean);
+begin
+  if aSaveAll then
+    SaveAllProjects(aCreatePoint)
+  else
+    SaveCurProject(aCreatePoint);
+end;
+
+procedure TProjectManager.SetReportsFirstGetData;
+var
+  I: Integer;
+  vReport: TReportData;
+begin
+  for I := 0 to FProjectList.Count - 1 do
+  begin
+    vReport := TProject(FProjectList[I]).Report;
+    vReport.FirstGetData := True;
+  end;
+end;
+
+function TProjectManager.GetProjectByID(AID: Integer): TProject;
+var i: Integer;
+begin
+  Result := nil;
+  for i := 0 to FProjectList.Count - 1 do
+  begin
+    if TProject(FProjectList[i]).ID = AID then
+    begin
+      Result := TProject(FProjectList[i]);
+      Break;
+    end;
+  end;
+end;
+
+function TProjectManager.RemoveProjectForClose(var CanColse: Boolean; Project: TProject = nil;
+  AProject: TProject = nil; IsExist: Boolean = True): Integer;
+
+var
+  curProject: TProject;
+  MQResult: Integer;
+begin
+  curProject := Project;
+  if not Assigned(Project) then
+  begin
+    curProject := FActiveProject;
+  end;
+
+  if Assigned(curProject) then
+  begin
+    if curProject.NeedSaveDatabase then
+    begin
+      if IsExist then
+      begin
+
+        MQResult := MessageBox(0, PChar(Format('项目 [%s] 已被修改,是否保存?', [curProject.ProjectName])), PChar('询问'), MB_YESNOCANCEL);
+        case MQResult of
+          ID_YES:
+          begin
+            CanColse := True;
+            curProject.Save(True);
+          end;
+          ID_NO:
+          begin
+            CanColse := True;
+          end;
+          IDCANCEL:
+          begin
+            CanColse := False;
+            Exit;
+          end;
+        end;
+      end
+      else
+        curProject.Save(True);
+    end
+    else
+      CanColse := True;
+
+    if CanColse then
+      Result := FProjectList.Remove(curProject);
+    curProject.Free;
+  end;
+  if Assigned(AProject) then
+    FActiveProject := AProject
+  else
+  begin
+    if FProjectList.Count = 0 then FActiveProject := nil
+    else if Result < FProjectList.Count then
+      FActiveProject := TProject(FProjectList[Result])
+    else FActiveProject := TProject(FProjectList[Result - 1]);
+  end;
+
+  FActiveIndex := FProjectList.IndexOf(FActiveProject);
+end;
+
+
+procedure TProjectManager.ResetAllOpenProjectView;
+var
+  i: Integer;
+begin
+  for i := 0 to FProjectList.Count - 1 do
+    TProject(FProjectList.Items[i]).ProjectView.LoadBillsViewOption;
+end;
+
+{ TProject }
+
+constructor TProject.Create(const FileName, aShortName: string;
+  ProjectType, aID: Integer);
+var
+  strNewPath: string;
+begin
+  FOpenForReport := False;
+  FChangedByReport := False;
+  FForceUndoSave := False;
+
+  strNewPath := FileName;
+  {project file path}
+  FFilePath := strNewPath;
+  FID := aID;
+
+  FArchiver := TScProjectFileArchiver.Create;
+  FArchiver.FileName := strNewPath;
+  // Added by GiLi 2012-3-16 16:09:41
+  FArchiver.Alias := '三级清单';
+  FArchiver.OpenFile;
+  if FArchiver.IsStdFile then
+  begin
+    FArchiver.IsStdFile := False;
+    FChanged := True;
+  end;
+
+  PScFileHead(@FArchiver.FileInfo).ProductName := ConstProductName;
+  FChanged := True;
+
+  FBillsData := TDMDataBase.Create(Self);
+  FBillsData.Connection := FArchiver.Connection;
+  UpdateDB(FArchiver);
+  {先打开数据,然后连接界面,效率快些}
+  FBillsData.Active := True;
+  FDMExprs := TDMExprs.Create(nil);
+  FDMExprs.Connection := FArchiver.Connection;
+  FBillsData.DMExprs := FDMExprs;
+  if ProjectType <> -1 then
+  begin
+    FBillsData.DeleteAllBills(False);
+    InitNewProject;
+  end;
+  FBillsData.ConnectionBillsTree;
+
+  FDMHisPoint := TDMHisRestorePoint.Create(nil);
+  FDMHisPoint.Connection := FArchiver.Connection;
+  FDMHisPoint.ProjectPath := FFilePath;
+  FDMHisPoint.ProjectName := aShortName;
+
+  {修改项目属性}
+  FProjPropertyDM := TProjPropertyDM.Create(nil);
+  FProjPropertyDM.Connection := FArchiver.Connection;
+  if ProjectType <> -1 then
+  begin
+    FProjPropertyDM.EditProjProperty(ProjectType);
+    FProjPropertyDM.Save;
+    // Added by GiLi 2012-3-16 16:09:41
+    FArchiver.Alias := aShortName;
+    FArchiver.Save;
+  end;
+  // Added by GiLi 2012-3-16 19:01:19
+  FArchiver.Alias := aShortName;
+  
+  FDetailItemsDM := TDMDetailItems.Create(Self);
+
+  FRecycleBinData := TRecycleBinData.Create(nil);
+  FRecycleBinData.Connection := FArchiver.Connection;
+
+  FReport := TReportData.Create(nil);
+  FReport.Project := Self;
+
+  FProjectView := TBillsProjectView.Create(Self);
+//  FProjectView.jpDetails.Height := 240;
+
+  ProjectName := aShortName;
+  FBillsData.EnabledUITreeEvt := FProjectView.ControlBillsTreeRT;
+  FBillsData.EnabledUIDrawQtyEvt := FProjectView.ControlDrawQtyRT;
+  FBillsData.DesignCodeEvt := FProjectView.ControlDesignCode;
+end;
+
+destructor TProject.Destroy;
+begin
+  FDetailItemsDM.Free;
+  FRecycleBinData.Free;
+  FreeAndNil(FArchiver);
+  { Note:first release UI, and then release database }
+  FreeAndNil(FProjectView);
+  FreeAndNil(FBillsData);
+  FreeAndNil(FDMHisPoint);
+  FreeAndNil(FDMExprs);
+  FreeAndNil(FProjPropertyDM);
+  FreeAndNil(FReport);
+  inherited;
+end;
+
+function TProject.GatherProject(ANewProject: TProject): Boolean;
+var
+  CacheGatherTree: TCacheGatherTree;
+begin
+  Result := False;
+
+  CacheGatherTree := TCacheGatherTree.Create;
+  IncProgressUI(15);
+
+  try
+    if CacheGatherTree.TraverseDBIntoSelf(Self) then
+    begin
+      IncProgressUI(35);
+      CacheGatherTree.TraverseOwnerIntoDB(ANewProject);
+      IncProgressUI(45);
+      
+      Result := True;
+    end;
+  finally
+    CacheGatherTree.Free;
+  end;
+end;
+
+procedure TProject.ImportExcelFile(const aFileName: string);
+var
+  exImportor: TExcelImportor;  
+begin
+  exImportor := TExcelImportor.Create(FBillsData, aFileName);
+  // Added by GiLi 2012-4-18 15:02:01
+  // 使用新的进度条
+  CreateProgressForm(100, '正在导入Excel清单文件>>>');
+  try
+    exImportor.ImportExcel;
+    FDetailItemsDM.PQEmptyDetail;
+  finally
+    exImportor.Free;
+    CloseFloatProgress;
+    IncProgressUI(100);
+  end;
+end;
+
+procedure TProject.InnerSave;
+begin
+  FBillsData.Save;
+  FDMExprs.Save;
+  FRecycleBinData.Save;
+//  FDMHisPoint.Save;
+end;
+
+function TProject.NeedSaveDatabase: Boolean;
+begin
+  Result := (FBillsData.ShouldSave or FChanged) and (not FForceUndoSave);
+end;
+
+procedure TProject.Save;
+begin
+  IncProgressUI(5);
+
+  InnerSave;
+  
+  IncProgressUI(60);
+
+  FArchiver.Save;
+
+  IncProgressUI(35);
+
+  FChanged := False;
+end;
+
+function TProject.NewFile(const aFileName, TempleteFile: string; var aNewName: string): Boolean;
+var
+  strTemPath: string;
+begin
+  strTemPath := Format('%s\Data\%s', [ExtractFileDir(ParamStr(0)), TempleteFile]);
+  aNewName := Format('%s\我的清单\%s.smb', [ExtractFileDir(ParamStr(0)), aFileName]);
+  Result := CopyFile(PChar(strTemPath), PChar(aNewName), True);
+end;
+
+procedure TProject.Save(const aCreatePoint: Boolean; aFixed: Boolean);
+begin
+  Save;
+  if aCreatePoint then FDMHisPoint.SavePoint(aFixed);
+  FArchiver.Save;
+end;
+
+procedure TProject.SaveAs(const FileName: string);
+begin
+  IncProgressUI(5);
+  InnerSave;
+  IncProgressUI(60);
+  FArchiver.SaveTo(FileName);
+  IncProgressUI(35);
+end;
+
+procedure TProject.SetStdBillsCtrl(const Value: TObject);
+begin
+  FStdBillsCtrl := Value;
+  FBillsData.StdBillsCtrl := FStdBillsCtrl;
+  FProjectView.StdBillsCtrl := FStdBillsCtrl;
+end;
+
+function TProject.GetProjectType: Integer;
+begin
+  Result := FProjPropertyDM.GetProjectType;
+end;
+
+procedure TProject.SetProjectName(const Value: string);
+begin
+  FProjectName := Value;
+  FDMHisPoint.ProjectName := FProjectName;
+end;
+
+procedure TProject.ImportQtyItems(const aFileName: string);
+var
+  exImportor: TExcelImportor;
+begin
+  exImportor := TExcelImportor.Create(FBillsData, aFileName);
+  try
+    exImportor.ImportQtyItems;
+  finally
+    exImportor.Free;
+  end;
+end;
+
+procedure TProject.ExportExcel(aProjMgr: TObject; const aFileName: string; aStrings: TStrings; aFlag: Integer);
+var
+  eeExportor: TExcelExportor;
+begin
+  eeExportor := TExcelExportor.Create(FBillsData, aProjMgr);
+  try
+    eeExportor.ExportToExcel(aFileName, aStrings, aFlag);
+  finally
+    eeExportor.Free;
+  end;
+end;
+
+function TProject.GetConnection: TADOConnection;
+begin
+  Result := FArchiver.Connection;
+end;
+
+function TProject.GetGatherID: Integer;
+begin
+  if FFlag = 3 then
+    Result := FParentID
+  else
+    Result := FID;
+end;
+
+procedure TProject.CheckBeforeGather;
+begin
+  if (FID = -1) or (FFlag = 1) then
+    raise Exception.Create('建设项目或预览项目不能汇总.');
+end;
+
+procedure TProject.SetBidLotList(const Value: TStrings);
+begin
+  FProjectView.BidLotList := Value;
+end;
+
+procedure TProject.SetFlag(const Value: Integer);
+begin
+  FFlag := Value;
+  FProjectView.ControlOwnerBid(FFlag);
+end;
+
+procedure TProject.InitNewProject;
+var
+  Decorator: TDecorator;
+begin
+  Decorator := TCreateDecorator.Create(FBillsData, {$I ProjectBills.inc});
+  try
+    Decorator.Decorate;
+  finally
+    Decorator.Free;
+  end;
+end;
+
+// Added by GiLi 2012-3-16 17:18:14
+// 重新设置文件的别名
+procedure TProject.ResetFileAlias(const sNewAlias: string);
+begin
+  if Assigned(FArchiver) then
+  begin
+    FArchiver.Alias := sNewAlias;
+    FArchiver.Save;
+  end
+  else
+    raise Exception.Create('文件重命名出错!');
+end;
+
+procedure TProject.ExportFlatExcel(const AFileName: string);
+var
+  Exportor: TFlatGclExcelExportor;
+begin
+  Exportor := TFlatGclExcelExportor.Create(FBillsData);
+  try
+    Exportor.ExportFile(aFileName);
+  finally
+    Exportor.Free;
+  end;
+end;
+
+end.

+ 224 - 0
CU/ScStdBillsCtrl.pas

@@ -0,0 +1,224 @@
+unit ScStdBillsCtrl;
+
+interface
+
+uses
+  StdBillsLibDM,
+  StdBillsLibForm,
+  ZjLists,
+  ScProjectManager,
+  Controls,
+  FXQDManagerUnit,
+  LocateBillsDM;
+
+type
+  TStdBillsCtrl = class
+  private
+    FDMStdBillsLib: TDMStdBillsLib;
+    FStdBillsLibFrm: TStdBillsLibFrm;
+    FBillsLocateDM: TBillsLocateDM;
+    FFXQDManager: TFXQDManager;
+
+    procedure SetIncStep(const Value: Integer);
+  public
+    constructor Create(AProjMgr: TProjectManager);
+    destructor Destroy; override;
+
+    {open new std lib}
+    procedure LoadNewStdLib(const ALibName: string);
+    procedure LoadBillsQtyLib(const ALibName: string);
+    {add items to cur project}
+    function AddItems(ASelList: TIntegerSList): Boolean;
+    procedure AddItem;
+    {add billsQty items}
+    function AddBillsQtyItems(aSelList: TIntegerSList): Boolean;
+    procedure AddBillsQtyItem;
+
+    { locatebills }
+    procedure FindFirstBills(const aCode: string);
+    procedure FindNextBills;
+    procedure LocateBills;
+    procedure RefreshBills;
+
+    {control ui refresh}
+    procedure BeginUpdateUI(aType: Integer);
+    procedure EndUpdateUI(aType: Integer);
+
+    // Added by GiLi 2012-3-20 10:10:04
+    // Add begin
+    // 当表格改变的时候,对界面需要的刷新操作
+    procedure BeginUpdateView;
+    procedure EndUpdateView;
+    // 表示项目表显示的层数
+    procedure ShowLevel(ALevel: Integer);
+    // 是否可以反向定位清单
+    function CanLocateAtStdBills: Boolean;
+    // 定位清单当前节点到标准清单中
+    procedure LocateAtStdBills;
+    // Add end
+    property StdBillsLibFrm: TStdBillsLibFrm read FStdBillsLibFrm;
+    property DMStdBillsLib: TDMStdBillsLib read FDMStdBillsLib;
+    property BillsLocateDM: TBillsLocateDM read FBillsLocateDM;
+    property FXQDManager: TFXQDManager read FFXQDManager;
+    property IncStep: Integer write SetIncStep;
+  end;
+
+implementation
+
+uses SysUtils;
+
+{ TStdBillsCtrl }
+
+procedure TStdBillsCtrl.AddBillsQtyItem;
+begin
+  FDMStdBillsLib.AddBillsQtyItem;
+end;
+
+function TStdBillsCtrl.AddBillsQtyItems(aSelList: TIntegerSList): Boolean;
+begin
+  FDMStdBillsLib.AddBillsQtyItems(aSelList);
+end;
+
+procedure TStdBillsCtrl.AddItem;
+begin
+  FDMStdBillsLib.AddItem;
+end;
+
+function TStdBillsCtrl.AddItems(ASelList: TIntegerSList): Boolean;
+begin
+  // Modified by GiLi 2012-3-19 18:52:39
+  // 添加清单失败,因为没有返回值
+  Result := FDMStdBillsLib.AddItems(ASelList);
+end;
+
+procedure TStdBillsCtrl.BeginUpdateUI(aType: Integer);
+begin
+  FStdBillsLibFrm.BeginUpdateUI(aType);
+end;
+
+procedure TStdBillsCtrl.BeginUpdateView;
+begin
+  FStdBillsLibFrm.zgBillsLib.BeginUpdate;
+  FStdBillsLibFrm.zgDrawingQuantity.BeginUpdate;
+end;
+
+function TStdBillsCtrl.CanLocateAtStdBills: Boolean;
+begin
+  {
+  if StdBillsLibFrm.zgBillsLib.ColCount = 0 then
+  begin
+    Result := False;
+    Exit;
+  end;
+  }
+  // 没有导入数据,不能反向定位
+  if not DMStdBillsLib.cdsBillsLib.Active then
+  begin
+    Result := False;
+    Exit;
+  end;
+  // 清单界面表格没有数据,不能反向定位
+  if DMStdBillsLib.cdsBillsLib.IsEmpty then
+  begin
+    Result := False;
+    Exit;
+  end;
+  Result := True;
+end;
+
+constructor TStdBillsCtrl.Create(AProjMgr: TProjectManager);
+begin
+  FDMStdBillsLib := TDMStdBillsLib.Create(AProjMgr);
+  FBillsLocateDM := TBillsLocateDM.Create(AProjMgr);
+
+  FStdBillsLibFrm := TStdBillsLibFrm.Create(nil);
+  FStdBillsLibFrm.ZgIDTree := FDMStdBillsLib.StdBillsTree;
+  FStdBillsLibFrm.DQDataSet := FDMStdBillsLib.cdsDrawQView;
+  FStdBillsLibFrm.BillsQtyTree := FDMStdBillsLib.BillsQtyTree;
+  FStdBillsLibFrm.QtyDQDataSet := FDMStdBillsLib.cdsBQDrawingQtyView;
+
+  FStdBillsLibFrm.StdBillsCtrl := Self;
+  FDMStdBillsLib.StdBillsCtrl := Self;
+
+  FFXQDManager := TFXQDManager.Create(AProjMgr);
+
+  FStdBillsLibFrm.LoadLibNames;
+  FStdBillsLibFrm.QtyItemDataSet := FBillsLocateDM.cdsQBItems;
+
+  FDMStdBillsLib.LoadCustomStep(ExtractFilePath(ParamStr(0)) + {$I CustomStep.inc});
+end;
+
+destructor TStdBillsCtrl.Destroy;
+begin
+  FDMStdBillsLib.Save;
+  FStdBillsLibFrm.Free;
+  FBillsLocateDM.Free;
+  FFXQDManager.Free;
+  FDMStdBillsLib.Free;
+  inherited;
+end;
+
+procedure TStdBillsCtrl.EndUpdateUI(aType: Integer);
+begin
+  FStdBillsLibFrm.EndUpdateUI(aType);
+end;
+
+procedure TStdBillsCtrl.EndUpdateView;
+begin
+  FStdBillsLibFrm.zgBillsLib.EndUpdate;
+  FStdBillsLibFrm.zgDrawingQuantity.EndUpdate;
+end;
+
+procedure TStdBillsCtrl.FindFirstBills(const aCode: string);
+begin
+  FBillsLocateDM.FindFirstBills(aCode);
+end;
+
+procedure TStdBillsCtrl.FindNextBills;
+begin
+  FBillsLocateDM.NextBills;
+end;
+
+procedure TStdBillsCtrl.LoadBillsQtyLib(const ALibName: string);
+begin
+  if FileExists(ALibName) then
+    FDMStdBillsLib.LoadBillsQtyLib(ALibName);
+end;
+
+procedure TStdBillsCtrl.LoadNewStdLib(const ALibName: string);
+begin
+  if FileExists(ALibName) then
+    FDMStdBillsLib.LoadNewStdLib(ALibName);
+end;
+
+procedure TStdBillsCtrl.LocateAtStdBills;
+begin
+  FDMStdBillsLib.LocateCurBillsToStdBills;
+end;
+
+procedure TStdBillsCtrl.LocateBills;
+begin
+  FBillsLocateDM.LocateBills;
+end;
+
+procedure TStdBillsCtrl.RefreshBills;
+begin
+  FBillsLocateDM.RefreshBills;
+end;
+
+procedure TStdBillsCtrl.SetIncStep(const Value: Integer);
+begin
+  FStdBillsLibFrm.IncStep := Value;
+end;
+
+procedure TStdBillsCtrl.ShowLevel(ALevel: Integer);
+begin
+  BeginUpdateView;
+  try
+    FDMStdBillsLib.StdBillsTree.ExpandLevel := ALevel;
+  finally
+    EndUpdateView;
+  end;   
+end;
+
+end.

+ 129 - 0
CU/ScTables.pas

@@ -0,0 +1,129 @@
+unit ScTables;
+
+interface
+
+type
+  TScMDBFieldType = (ftString, ftByte, ftSmallint, ftInteger, ftBoolean, ftSingle, ftDouble,
+    ftCurrency, ftDateTime, ftMemo, ftOLEObject);
+
+  TScFieldDef = record
+    FieldName: string;
+    FieldType: TScMDBFieldType;
+    Size: Integer;
+    NotNull: Boolean;
+    PrimaryKey: Boolean;
+  end;
+
+  PScFieldDef = ^TScFieldDef;
+
+const
+  ScMDBFieldTypeName: array [TScMDBFieldType] of string = (
+    'Text', 'Byte', 'Smallint', 'Integer', 'Bit', 'Single', 'Double',
+    'Currency', 'DateTime', 'Memo', 'OLEObject');
+
+  {Bills}
+
+  SBills = 'Bills';
+  tdBills: array [0..19] of TScFieldDef = (
+    (FieldName: 'Selected'; FieldType: ftBoolean; Size: 0; NotNull: False; PrimaryKey: False),
+    (FieldName: 'OwnerName'; FieldType: ftString; Size: 50; NotNull: False; PrimaryKey: False),
+    (FieldName: 'CustomValue'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False),
+    (FieldName: 'ErrorHint'; FieldType: ftString; Size: 255; NotNull: False; PrimaryKey: False),
+    (FieldName: 'IsSuperscale'; FieldType: ftBoolean; Size: 0; NotNull: False; PrimaryKey: False),
+    (FieldName: 'StandardGrade'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False),
+    (FieldName: 'DeductGrade'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False),
+    (FieldName: 'IsIgNore'; FieldType: ftBoolean; Size: 0; NotNull: False; PrimaryKey: False),
+    (FieldName: 'UserModified'; FieldType: ftBoolean; Size: 0; NotNull: False; PrimaryKey: False),
+    (FieldName: 'LostPreSiblingCount'; FieldType: ftInteger; Size: 0; NotNull: False; PrimaryKey: False),
+    (FieldName: 'LostChildrenCount'; FieldType: ftInteger; Size: 0; NotNull: False; PrimaryKey: False),
+    (FieldName: 'LostNextSiblingCount'; FieldType: ftInteger; Size: 0; NotNull: False; PrimaryKey: False),
+    (FieldName: 'NameErrorFlag'; FieldType: ftInteger; Size: 0; NotNull: False; PrimaryKey: False),
+    (FieldName: 'UnitsErrorFlag'; FieldType: ftInteger; Size: 0; NotNull: False; PrimaryKey: False),
+    (FieldName: 'RightName'; FieldType: ftString; Size: 255; NotNull: False; PrimaryKey: False),
+    (FieldName: 'RightUnits'; FieldType: ftString; Size: 255; NotNull: False; PrimaryKey: False),
+    (FieldName: 'ChapterID'; FieldType: ftInteger; Size: 0; NotNull: False; PrimaryKey: False),
+    (FieldName: 'B_CodeAlpha'; FieldType: ftString; Size: 255; NotNull: False; PrimaryKey: False),
+    (FieldName: 'IsAccQuantity'; FieldType: ftBoolean; Size: 0; NotNull: False; PrimaryKey: False),
+    (FieldName: 'DrawingCode'; FieldType: ftString; Size: 50; NotNull: False; PrimaryKey: False)
+  );
+
+  { ±í DrawingQuantity ¶¨Òå }
+  SDrawingQuantity = 'DrawingQuantity';
+  tdDrawingQuantity: array [0..3] of TScFieldDef = (
+    (FieldName: 'IsGatherQty'; FieldType: ftBoolean; Size: 0; NotNull: False; PrimaryKey: False),
+    (FieldName: 'IsGatherQ'; FieldType: ftBoolean; Size: 0; NotNull: False; PrimaryKey: False),    
+    (FieldName: 'SerinalNo'; FieldType: ftInteger; Size: 0; NotNull: False; PrimaryKey: False),
+    (FieldName: 'MemoContext'; FieldType: ftString; Size: 200; NotNull: False; PrimaryKey: False)
+  );
+
+  {DQ Calculate Expression}
+  SDQCalcExpression = 'DQCalcExpression';
+  tdDQCalcExpression: array [0..3] of TScFieldDef = (
+    (FieldName: 'ID'; FieldType: ftInteger; Size: 0; NotNull: True; PrimaryKey: True),
+    (FieldName: 'DQID'; FieldType: ftInteger; Size: 0; NotNull: False; PrimaryKey: False),
+    (FieldName: 'PileName'; FieldType: ftString; Size: 100; NotNull: False; PrimaryKey: False),
+    (FieldName: 'ExprsValue'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False)
+  );
+
+  {Restore point}
+  SHisRestorePoints = 'HisRestorePoints';
+  tdHisRestorePoints: array [0..4] of TScFieldDef = (
+    (FieldName: 'ID'; FieldType: ftInteger; Size: 0; NotNull: True; PrimaryKey: True),
+    (FieldName: 'Fixed'; FieldType: ftBoolean; Size: 0; NotNull: True; PrimaryKey: True),
+    (FieldName: 'CreateTime'; FieldType: ftDateTime; Size: 0; NotNull: True; PrimaryKey: True),
+    (FieldName: 'FileName'; FieldType: ftString; Size: 100; NotNull: False; PrimaryKey: False),
+    (FieldName: 'FileDir'; FieldType: ftString; Size: 200; NotNull: False; PrimaryKey: False)
+  );
+
+  { Split }
+
+  SBidLot = 'BidLot';
+  tdBidLot: array [0..4] of TScFieldDef = (
+    (FieldName: 'ID'; FieldType: ftInteger; Size: 0; NotNull: True; PrimaryKey: True),
+    (FieldName: 'ProjName'; FieldType: ftString; Size: 200; NotNull: False; PrimaryKey: False),
+    (FieldName: 'AliasName'; FieldType: ftString; Size: 50; NotNull: False; PrimaryKey: False),
+    (FieldName: 'FullName'; FieldType: ftString; Size: 100; NotNull: False; PrimaryKey: False),
+    (FieldName: 'Flag'; FieldType: ftInteger; Size: 0; NotNull: False; PrimaryKey: False)
+  );
+
+  // ±íGradeStat
+  SGradeStat = 'GradeStat';
+  tdGradeStat: array [0..10] of TScFieldDef = (
+    (FieldName: 'ChapterID'; FieldType: ftInteger; Size: 0; NotNull: True; PrimaryKey: True),
+    (FieldName: 'Code'; FieldType: ftString; Size: 255; NotNull: False; PrimaryKey: False),
+    (FieldName: 'Name'; FieldType: ftString; Size: 255; NotNull: False; PrimaryKey: False),
+    (FieldName: 'StandardGrade'; FieldType: ftCurrency; Size: 4; NotNull: False; PrimaryKey: False),
+    (FieldName: 'DeductGrade'; FieldType: ftCurrency; Size: 4; NotNull: False; PrimaryKey: False),
+    (FieldName: 'ActureMark'; FieldType: ftCurrency; Size: 4; NotNull: False; PrimaryKey: False),
+    (FieldName: 'TotalMark'; FieldType: ftCurrency; Size: 4; NotNull: False; PrimaryKey: False),
+    (FieldName: 'StdMarkPercent'; FieldType: ftCurrency; Size: 4; NotNull: False; PrimaryKey: False),
+    (FieldName: 'ResultMark'; FieldType: ftCurrency; Size: 4; NotNull: False; PrimaryKey: False),
+    (FieldName: 'YsCount'; FieldType: ftInteger; Size: 0; NotNull: False; PrimaryKey: False),
+    (FieldName: 'QdCount'; FieldType: ftInteger; Size: 0; NotNull: False; PrimaryKey: False)
+    );
+
+//   ±íGradeStatTotal
+  SGradeStatTotal = 'GradeStatTotal';
+  tdGradeStatTotal: array [0..7] of TScFieldDef = (
+    (FieldName: 'ID'; FieldType: ftInteger; Size: 0; NotNull: True; PrimaryKey: True),
+    (FieldName: 'StandardGradeTotal'; FieldType: ftCurrency; Size: 4; NotNull: False; PrimaryKey: False),
+    (FieldName: 'DeductGradeTotal'; FieldType: ftCurrency; Size: 4; NotNull: False; PrimaryKey: False),
+    (FieldName: 'ResultMarkTotal'; FieldType: ftCurrency; Size: 4; NotNull: False; PrimaryKey: False),
+    (FieldName: 'YsCountTotal'; FieldType: ftInteger; Size: 0; NotNull: False; PrimaryKey: False),
+    (FieldName: 'QdCountTotal'; FieldType: ftInteger; Size: 0; NotNull: False; PrimaryKey: False),
+    (FieldName: 'AdditionalMark'; FieldType: ftCurrency; Size: 4; NotNull: False; PrimaryKey: False),
+    (FieldName: 'QualityMark'; FieldType: ftCurrency; Size: 4; NotNull: False; PrimaryKey: False)
+    );
+
+//   ±íGradeStatTotal
+  SRecycleBin = 'RecycleBin';
+  tdRecycleBin: array [0..3] of TScFieldDef = (
+    (FieldName: 'ID'; FieldType: ftInteger; Size: 0; NotNull: True; PrimaryKey: True),
+    (FieldName: 'Name'; FieldType: ftString; Size: 50; NotNull: False; PrimaryKey: False),
+    (FieldName: 'CreateTime'; FieldType: ftString; Size: 20; NotNull: False; PrimaryKey: False),
+    (FieldName: 'FileName'; FieldType: ftString; Size: 100; NotNull: False; PrimaryKey: False)
+    );
+
+implementation
+
+end.

+ 68 - 0
CU/ScUpdateDataBase.pas

@@ -0,0 +1,68 @@
+unit ScUpdateDataBase;
+
+interface
+
+uses
+  SysUtils, ScFileArchiver, ADODB, ScTables, ScAutoUpdateUnit;
+
+function UpdateDB(AFileArchiver: TScMDBArchiver): Boolean;
+
+implementation
+
+uses ConstMethodUnit;
+
+procedure DoProjectOnUpdateData(ATableName: string; AEventType: TUpdateEventType;
+  ASQLType: TSQLType; AConnection: TADOConnection);
+var
+  aqQuery: TADOQuery;
+begin
+  aqQuery := TADOQuery.Create(nil);
+  try
+    aqQuery.Connection := AConnection;
+    if AEventType = uetAddFields then
+    begin
+      if ATableName = 'DrawingQuantity' then
+      begin
+        aqQuery.SQL.Add(Format('Update %s Set IsGatherQ = IsGatherQty', [ATableName]));
+        aqQuery.ExecSQL;
+      end;
+    end;
+  finally
+    aqQuery.Free;
+  end;
+end;
+
+
+function UpdateDB(AFileArchiver: TScMDBArchiver): Boolean;
+var
+  Updater: TScUpdater;
+begin
+  Updater := TScUpdater.Create;
+  try
+    Updater.OnUpdateData := DoProjectOnUpdateData;
+    Updater.Open(AFileArchiver.FileName, AFileArchiver.Connection, AFileArchiver.FileInfo.FileVersion);
+    Result := Updater.FileNeedUpdate;
+    if Result then
+    begin
+      {Update tables}
+      Updater.AddTableDef(SBills, @tdBills, Length(tdBills), False, False);
+      Updater.AddTableDef(SDrawingQuantity, @tdDrawingQuantity, Length(tdDrawingQuantity), False, False);
+      Updater.AddTableDef(SDQCalcExpression, @tdDQCalcExpression, Length(tdDQCalcExpression), False, False);
+      Updater.AddTableDef(SHisRestorePoints, @tdHisRestorePoints, Length(tdHisRestorePoints), False, False);
+      Updater.AddTableDef(SBidLot, @tdBidLot, Length(tdBidLot), False, False);      
+      Updater.AddTableDef(SGradeStat, @tdGradeStat, Length(tdGradeStat), False, False);
+      Updater.AddTableDef(SGradeStatTotal, @tdGradeStatTotal, Length(tdGradeStatTotal), False, False);
+      Updater.AddTableDef(SRecycleBin, @tdRecycleBin, Length(tdRecycleBin), False, False);
+      Result := Updater.ExcuteUpdate;
+      if Result then
+      begin
+        AFileArchiver.SetFileVer(ConstBillsFileVersion);
+//        AFileArchiver.SetFileVer(ConstBudgetFileVersion);
+      end;
+    end;
+  finally
+    Updater.Free;
+  end;
+end;
+
+end.

+ 59 - 0
CU/SingleObjectAggregateUnit.pas

@@ -0,0 +1,59 @@
+unit SingleObjectAggregateUnit;
+
+interface
+
+uses
+  BidLotDM;
+
+type
+
+  TSingleObjectAggregate = class
+  private
+    FBidLotDM: TBidLotDataModule;
+
+    function GetBidLotDM: TBidLotDataModule;
+  public
+    destructor Destroy; override;
+
+    property BidLotDM: TBidLotDataModule read GetBidLotDM;
+  end;
+
+
+  { Single Object Manager }
+  function SingleObjectAggregate: TSingleObjectAggregate;
+
+implementation
+
+var
+  gl_ingleObjectAggregate: TSingleObjectAggregate;
+
+function SingleObjectAggregate: TSingleObjectAggregate;
+begin
+  if not Assigned(gl_ingleObjectAggregate) then
+    gl_ingleObjectAggregate := TSingleObjectAggregate.Create;
+
+  Result := gl_ingleObjectAggregate;
+end;
+
+{ TSingleObjectAggregate }
+
+destructor TSingleObjectAggregate.Destroy;
+begin
+  FBidLotDM.Free;
+  inherited;
+end;
+
+function TSingleObjectAggregate.GetBidLotDM: TBidLotDataModule;
+begin
+  if FBidLotDM = nil then
+    FBidLotDM := TBidLotDataModule.Create(nil);
+  Result := FBidLotDM;
+end;
+
+initialization
+
+finalization
+  gl_ingleObjectAggregate.Free;
+
+end.
+ 

+ 31 - 0
DB/BidLotDM.dfm

@@ -0,0 +1,31 @@
+object BidLotDataModule: TBidLotDataModule
+  OldCreateOrder = False
+  Left = 503
+  Top = 318
+  Height = 179
+  Width = 233
+  object atBidLot: TADOTable
+    AfterPost = atBidLotAfterPost
+    TableName = 'BidLot'
+    Left = 88
+    Top = 32
+    object atBidLotID: TIntegerField
+      FieldName = 'ID'
+    end
+    object atBidLotProjName: TWideStringField
+      FieldName = 'ProjName'
+      Size = 200
+    end
+    object atBidLotAliasName: TWideStringField
+      FieldName = 'AliasName'
+      Size = 50
+    end
+    object atBidLotFullName: TWideStringField
+      FieldName = 'FullName'
+      Size = 100
+    end
+    object atBidLotFlag: TIntegerField
+      FieldName = 'Flag'
+    end
+  end
+end

+ 248 - 0
DB/BidLotDM.pas

@@ -0,0 +1,248 @@
+unit BidLotDM;
+
+interface
+
+uses
+  SysUtils,
+  Classes,
+  DB,
+  ConstTypeUnit,
+  ADODB;
+
+type
+  TBidLotDataModule = class(TDataModule)
+    atBidLot: TADOTable;
+    atBidLotID: TIntegerField;
+    atBidLotProjName: TWideStringField;
+    atBidLotAliasName: TWideStringField;
+    atBidLotFullName: TWideStringField;
+    atBidLotFlag: TIntegerField;
+    procedure atBidLotAfterPost(DataSet: TDataSet);
+  private
+    FProject: TObject;
+
+    function MaxBidLotID: Integer;
+    function CheckBidLot(const aProjName, aFullName: string): Boolean;
+
+    procedure BeginRefresh;
+    procedure EndRefresh;
+
+    procedure ExecuteSQL(const aSQL: string);
+    procedure AddBidLot(const aProjName, aFullName: string);
+    procedure DeleteBidLot(const aProjName, aFullName: string);
+    procedure ReNameBidLot(const aProjName, aFullName: string);
+
+    function GetBidLotDB: TDataSet;
+    procedure SetProject(const Value: TObject);
+  public
+    procedure Notify(aOperation: TBidLotOperation; const aProjName, aFullName: string);
+    procedure RefreshBidLot(aStrings: TStrings);
+    procedure SyncProjectView;
+
+    property Project: TObject read FProject write SetProject;
+    property BidLotDB: TDataSet read GetBidLotDB;
+  end;
+
+implementation
+
+uses
+  ScProjectManager;
+
+{$R *.dfm}
+
+{ TBidLotDataModule }
+
+procedure TBidLotDataModule.AddBidLot(const aProjName, aFullName: string);
+begin
+  if not atBidLot.Active then Exit;
+
+  atBidLot.Append;
+  atBidLotID.Value        := MaxBidLotID;
+  atBidLotProjName.Value  := aProjName;
+  atBidLotAliasName.Value := aProjName;
+  atBidLotFullName.Value  := aFullName;
+  atBidLotFlag.Value      := 1;                
+  atBidLot.Post;
+end;
+
+procedure TBidLotDataModule.BeginRefresh;
+var
+  sSQL: string;
+begin
+  sSQL := 'Update BidLot Set Flag = 0';
+
+  ExecuteSQL(sSQL);
+end;
+
+function TBidLotDataModule.CheckBidLot(const aProjName,
+  aFullName: string): Boolean;
+var
+  aqQuery: TADOQuery;
+begin
+  aqQuery := TADOQuery.Create(nil);
+  try
+    aqQuery.Connection := TProject(FProject).Connection;
+
+    aqQuery.SQL.Text := Format('Select * From BidLot Where ' +
+                               '(ProjName = ''%s'') and (FullName = ''%s'')',
+                               [aProjName, aFullName]);
+    aqQuery.Open;
+
+    Result := aqQuery.RecordCount > 0;
+
+    if Result then
+    begin
+      aqQuery.Edit;
+      aqQuery.FieldByName('Flag').AsInteger := 1;
+      aqQuery.Post;
+    end;
+  finally
+    aqQuery.Free;
+  end;
+end;
+
+procedure TBidLotDataModule.DeleteBidLot(const aProjName,
+  aFullName: string);
+var
+  sSQL: string;
+begin
+  sSQL := Format('Delete * From BidLot Where ' +
+                 '(ProjName = ''%s'') and (FullName = ''%s'')',
+                 [aProjName, aFullName]);
+
+  ExecuteSQL(sSQL);
+//  atBidLot.Refresh;
+end;
+
+procedure TBidLotDataModule.EndRefresh;
+var
+  sSQL: string;
+begin
+  sSQL := 'Delete * From BidLot Where Flag = 0';
+
+  ExecuteSQL(sSQL);
+end;
+
+procedure TBidLotDataModule.ExecuteSQL(const aSQL: string);
+var
+  aqQuery: TADOQuery;
+begin
+  aqQuery := TADOQuery.Create(nil);
+  try
+    aqQuery.Connection := TProject(FProject).Connection;
+
+    aqQuery.SQL.Text := aSQL;
+    aqQuery.ExecSQL;
+
+  finally
+    aqQuery.Free;
+  end;
+end;
+
+function TBidLotDataModule.GetBidLotDB: TDataSet;
+begin
+  Result := atBidLot;
+end;
+
+function TBidLotDataModule.MaxBidLotID: Integer;
+var
+  aqQuery: TADOQuery;
+begin
+  aqQuery := TADOQuery.Create(nil);
+  try
+    aqQuery.Connection := TProject(FProject).Connection;
+
+    aqQuery.SQL.Text := 'Select Max(ID) As ID From BidLot';
+    aqQuery.Open;
+
+    Result := aqQuery.FieldByName('ID').AsInteger + 1;
+  finally
+    aqQuery.Free;
+  end;
+end;
+
+procedure TBidLotDataModule.Notify(aOperation: TBidLotOperation;
+  const aProjName, aFullName: string);
+begin
+  if FProject = nil then Exit;
+  case aOperation of
+    boAdd    : AddBidLot(aProjName, aFullName);
+    boDelete : DeleteBidLot(aProjName, aFullName);
+    boReName : ReNameBidLot(aProjName, aFullName);
+  end;
+  TProject(FProject).Changed := True;
+end;
+
+procedure TBidLotDataModule.RefreshBidLot(aStrings: TStrings);
+var
+  I: Integer;
+  sProjName, sFullName: string;
+begin
+  BeginRefresh;
+
+  for I := 0 to aStrings.Count - 1 do
+  begin
+    sProjName := aStrings[I];
+    sFullName := string(aStrings.Objects[I]);
+
+    if not CheckBidLot(sProjName, sFullName) then
+      AddBidLot(sProjName, sFullName);
+  end;
+
+  EndRefresh;
+
+  atBidLot.Active := False;
+  atBidLot.Active := True;
+  atBidLot.First;
+end;
+
+procedure TBidLotDataModule.ReNameBidLot(const aProjName,
+  aFullName: string);
+var
+  sSQL: string;
+begin
+  sSQL := Format('Update BidLot Set ProjName = ''%s'' Where ' +
+                 'FullName = ''%s''',
+                 [aProjName, aFullName]);
+
+  ExecuteSQL(sSQL);
+end;
+
+procedure TBidLotDataModule.SetProject(const Value: TObject);
+begin
+  FProject := Value;
+  if Assigned(FProject) then
+  begin
+    atBidLot.Connection := TProject(FProject).Connection;
+    atBidLot.Active := True;
+  end;
+end;
+
+procedure TBidLotDataModule.SyncProjectView;
+var
+  sgsBidLot: TStrings;
+begin
+  atBidLot.Active := False;
+  atBidLot.Active := True;
+
+  sgsBidLot := TStringList.Create;
+  try
+    atBidLot.First;
+    while not atBidLot.Eof do
+    begin
+      sgsBidLot.Add(atBidLotAliasName.Value);
+      atBidLot.Next;
+    end;
+
+    TProject(FProject).BidLotList := sgsBidLot;
+  finally
+    sgsBidLot.Free;
+  end;
+end;
+
+procedure TBidLotDataModule.atBidLotAfterPost(DataSet: TDataSet);
+begin
+  TProject(FProject).Changed := True;
+end;
+
+end.

BIN
DB/DataBase.ddp


+ 936 - 0
DB/DataBase.dfm

@@ -0,0 +1,936 @@
+object DMDataBase: TDMDataBase
+  OldCreateOrder = False
+  OnCreate = DataModuleCreate
+  OnDestroy = DataModuleDestroy
+  Left = 942
+  Top = 89
+  Height = 625
+  Width = 498
+  object atBills: TADOTable
+    CursorType = ctStatic
+    TableName = 'Bills'
+    Left = 34
+    Top = 42
+  end
+  object atDrawingQuantity: TADOTable
+    CursorType = ctStatic
+    TableName = 'DrawingQuantity'
+    Left = 172
+    Top = 39
+  end
+  object dspBills: TDataSetProvider
+    DataSet = atBills
+    UpdateMode = upWhereKeyOnly
+    Left = 34
+    Top = 114
+  end
+  object dspDrawingQuantity: TDataSetProvider
+    DataSet = atDrawingQuantity
+    UpdateMode = upWhereKeyOnly
+    Left = 172
+    Top = 111
+  end
+  object cdsBills: TClientDataSet
+    Aggregates = <>
+    Params = <>
+    ProviderName = 'dspBills'
+    AfterOpen = cdsBillsAfterOpen
+    AfterInsert = cdsBillsAfterInsert
+    AfterPost = cdsBillsAfterPost
+    Left = 33
+    Top = 193
+    object cdsBillsID: TIntegerField
+      FieldName = 'ID'
+    end
+    object cdsBillsParentID: TIntegerField
+      FieldName = 'ParentID'
+    end
+    object cdsBillsNextSiblingID: TIntegerField
+      FieldName = 'NextSiblingID'
+    end
+    object cdsBillsCode: TWideStringField
+      FieldName = 'Code'
+      OnChange = cdsOrgBillsCodeChange
+      Size = 50
+    end
+    object cdsBillsName: TWideStringField
+      FieldName = 'Name'
+      OnChange = cdsOrgBillsCodeChange
+      Size = 128
+    end
+    object cdsBillsUnits: TWideStringField
+      FieldName = 'Units'
+      Size = 50
+    end
+    object cdsBillsQuantity: TFloatField
+      FieldName = 'Quantity'
+    end
+    object cdsBillsUnitPrice: TBCDField
+      FieldName = 'UnitPrice'
+      Precision = 19
+    end
+    object cdsBillsTotalPrice: TBCDField
+      FieldName = 'TotalPrice'
+      Precision = 19
+    end
+    object cdsBillsB_Code: TWideStringField
+      FieldName = 'B_Code'
+      OnChange = cdsOrgBillsCodeChange
+      Size = 255
+    end
+    object cdsBillsDesignQuantity: TFloatField
+      FieldName = 'DesignQuantity'
+    end
+    object cdsBillsDesignQuantity2: TFloatField
+      FieldName = 'DesignQuantity2'
+    end
+    object cdsBillsDesignPrice: TFloatField
+      FieldName = 'DesignPrice'
+    end
+    object cdsBillsMemoStr: TMemoField
+      FieldName = 'MemoStr'
+      BlobType = ftMemo
+    end
+    object cdsBillsIsPreDefine: TBooleanField
+      FieldName = 'IsPreDefine'
+    end
+    object cdsBillsSelected: TBooleanField
+      FieldName = 'Selected'
+    end
+    object cdsBillsCustomValue: TFloatField
+      FieldName = 'CustomValue'
+    end
+    object cdsBillsSerialNo: TIntegerField
+      FieldName = 'SerialNo'
+    end
+    object cdsBillsLostNextSiblingCount: TIntegerField
+      FieldName = 'LostNextSiblingCount'
+      OnChange = cdsBillsLostNextSiblingCountChange
+    end
+    object cdsBillsLostChildrenCount: TIntegerField
+      FieldName = 'LostChildrenCount'
+      OnChange = cdsBillsLostNextSiblingCountChange
+    end
+    object cdsBillsLostPreSiblingCount: TIntegerField
+      FieldName = 'LostPreSiblingCount'
+      OnChange = cdsBillsLostNextSiblingCountChange
+    end
+    object cdsBillsUserModified: TBooleanField
+      FieldName = 'UserModified'
+      OnChange = cdsBillsLostNextSiblingCountChange
+    end
+    object cdsBillsIsIgNore: TBooleanField
+      FieldName = 'IsIgNore'
+      OnChange = cdsBillsLostNextSiblingCountChange
+    end
+    object cdsBillsDeductGrade: TFloatField
+      FieldName = 'DeductGrade'
+      OnChange = cdsBillsLostNextSiblingCountChange
+    end
+    object cdsBillsStandardGrade: TFloatField
+      FieldName = 'StandardGrade'
+      OnChange = cdsBillsLostNextSiblingCountChange
+    end
+    object cdsBillsIsSuperscale: TBooleanField
+      FieldName = 'IsSuperscale'
+      OnChange = cdsBillsLostNextSiblingCountChange
+    end
+    object cdsBillsErrorHint: TWideStringField
+      FieldName = 'ErrorHint'
+      OnChange = cdsBillsLostNextSiblingCountChange
+      Size = 255
+    end
+    object cdsBillsNameErrorFlag: TIntegerField
+      FieldName = 'NameErrorFlag'
+      OnChange = cdsBillsLostNextSiblingCountChange
+    end
+    object cdsBillsUnitsErrorFlag: TIntegerField
+      FieldName = 'UnitsErrorFlag'
+      OnChange = cdsBillsLostNextSiblingCountChange
+    end
+    object cdsBillsChapterID: TIntegerField
+      FieldName = 'ChapterID'
+    end
+    object cdsBillsFullCode: TWideStringField
+      FieldName = 'FullCode'
+      Size = 128
+    end
+    object cdsBillsRightName: TWideStringField
+      FieldName = 'RightName'
+      Size = 255
+    end
+    object cdsBillsRightUnits: TWideStringField
+      FieldName = 'RightUnits'
+      Size = 255
+    end
+    object cdsBillsIsLeaf: TBooleanField
+      FieldName = 'IsLeaf'
+    end
+    object cdsBillsIsCreatePriceAnalysis: TBooleanField
+      FieldName = 'IsCreatePriceAnalysis'
+    end
+    object cdsBillsB_CodeAlpha: TWideStringField
+      FieldName = 'B_CodeAlpha'
+      Size = 255
+    end
+    object cdsBillsIsAccQuantity: TBooleanField
+      FieldName = 'IsAccQuantity'
+    end
+    object cdsBillsDrawingCode: TWideStringField
+      FieldName = 'DrawingCode'
+      Size = 50
+    end
+  end
+  object cdsDrawingQuantity: TClientDataSet
+    Aggregates = <>
+    Params = <>
+    ProviderName = 'dspDrawingQuantity'
+    AfterOpen = cdsDrawingQuantityAfterOpen
+    AfterInsert = cdsDrawingQuantityAfterInsert
+    Left = 172
+    Top = 190
+    object cdsDrawingQuantityID: TIntegerField
+      FieldName = 'ID'
+    end
+    object cdsDrawingQuantityName: TWideStringField
+      FieldName = 'Name'
+      Size = 200
+    end
+    object cdsDrawingQuantityUnits: TWideStringField
+      FieldName = 'Units'
+      Size = 50
+    end
+    object cdsDrawingQuantityBillsID: TIntegerField
+      FieldName = 'BillsID'
+    end
+    object cdsDrawingQuantityDQuantity1: TFloatField
+      FieldName = 'DQuantity1'
+    end
+    object cdsDrawingQuantityDQuantity2: TFloatField
+      FieldName = 'DQuantity2'
+    end
+    object cdsDrawingQuantityMemoContext: TWideStringField
+      FieldName = 'MemoContext'
+      Size = 200
+    end
+    object cdsDrawingQuantitySerinalNo: TIntegerField
+      FieldName = 'SerinalNo'
+    end
+    object cdsDrawingQuantityIsGatherQ: TBooleanField
+      FieldName = 'IsGatherQ'
+    end
+  end
+  object dsBillsDrawing: TDataSource
+    DataSet = cdsOrgBills
+    Left = 154
+    Top = 314
+  end
+  object cdsOrgBills: TClientDataSet
+    Aggregates = <>
+    Params = <>
+    AfterInsert = cdsOrgBillsAfterInsert
+    BeforeEdit = cdsOrgBillsBeforeEdit
+    BeforePost = cdsOrgBillsBeforePost
+    AfterPost = cdsOrgBillsAfterPost
+    AfterScroll = cdsOrgBillsAfterScroll
+    Left = 42
+    Top = 312
+    object cdsOrgBillsChapterID: TIntegerField
+      FieldName = 'ChapterID'
+    end
+    object cdsOrgBillsID: TIntegerField
+      FieldName = 'ID'
+    end
+    object cdsOrgBillsParentID: TIntegerField
+      FieldName = 'ParentID'
+      OnChange = cdsOrgBillsCodeChange
+    end
+    object cdsOrgBillsIsPreDefine: TBooleanField
+      FieldName = 'IsPreDefine'
+    end
+    object cdsOrgBillsNextSiblingID: TIntegerField
+      FieldName = 'NextSiblingID'
+      OnChange = cdsOrgBillsCodeChange
+    end
+    object cdsOrgBillsCode: TWideStringField
+      FieldName = 'Code'
+      OnChange = cdsOrgBillsCodeChange
+      Size = 50
+    end
+    object cdsOrgBillsName: TWideStringField
+      FieldName = 'Name'
+      OnChange = cdsOrgBillsCodeChange
+      Size = 128
+    end
+    object cdsOrgBillsUnits: TWideStringField
+      FieldName = 'Units'
+      OnChange = cdsOrgBillsCodeChange
+      Size = 50
+    end
+    object cdsOrgBillsQuantity: TFloatField
+      FieldName = 'Quantity'
+      OnChange = cdsOrgBillsCodeChange
+      OnGetText = cdsOrgBillsQuantityGetText
+      OnSetText = cdsOrgBillsQuantitySetText
+    end
+    object cdsOrgBillsUnitPrice: TBCDField
+      FieldName = 'UnitPrice'
+      OnChange = cdsOrgBillsCodeChange
+      OnGetText = cdsOrgBillsUnitPriceGetText
+      Precision = 19
+    end
+    object cdsOrgBillsTotalPrice: TBCDField
+      FieldName = 'TotalPrice'
+      OnChange = cdsOrgBillsCodeChange
+      OnGetText = cdsOrgBillsUnitPriceGetText
+      Precision = 19
+    end
+    object cdsOrgBillsB_Code: TWideStringField
+      FieldName = 'B_Code'
+      OnChange = cdsOrgBillsCodeChange
+      Size = 255
+    end
+    object cdsOrgBillsDesignQuantity: TFloatField
+      FieldName = 'DesignQuantity'
+      OnChange = cdsOrgBillsCodeChange
+      OnGetText = cdsOrgBillsQuantityGetText
+      OnSetText = cdsOrgBillsQuantitySetText
+    end
+    object cdsOrgBillsDesignQuantity2: TFloatField
+      FieldName = 'DesignQuantity2'
+      OnChange = cdsOrgBillsCodeChange
+      OnGetText = cdsOrgBillsQuantityGetText
+      OnSetText = cdsOrgBillsQuantitySetText
+    end
+    object cdsOrgBillsDesignPrice: TFloatField
+      FieldName = 'DesignPrice'
+      OnChange = cdsOrgBillsCodeChange
+      OnGetText = cdsOrgBillsUnitPriceGetText
+    end
+    object cdsOrgBillsMemoStr: TMemoField
+      FieldName = 'MemoStr'
+      BlobType = ftMemo
+    end
+    object cdsOrgBillsSelected: TBooleanField
+      FieldName = 'Selected'
+    end
+    object cdsOrgBillsOwnerName: TWideStringField
+      FieldName = 'OwnerName'
+      Size = 50
+    end
+    object cdsOrgBillsCustomValue: TFloatField
+      FieldName = 'CustomValue'
+    end
+    object cdsOrgBillsSerialNo: TIntegerField
+      FieldName = 'SerialNo'
+    end
+    object cdsOrgBillsLostNextSiblingCount: TIntegerField
+      FieldName = 'LostNextSiblingCount'
+      OnChange = cdsOrgBillsLostNextSiblingCountChange
+    end
+    object cdsOrgBillsLostChildrenCount: TIntegerField
+      FieldName = 'LostChildrenCount'
+      OnChange = cdsOrgBillsLostNextSiblingCountChange
+    end
+    object cdsOrgBillsLostPreSiblingCount: TIntegerField
+      FieldName = 'LostPreSiblingCount'
+      OnChange = cdsOrgBillsLostNextSiblingCountChange
+    end
+    object cdsOrgBillsUserModified: TBooleanField
+      FieldName = 'UserModified'
+      OnChange = cdsOrgBillsLostNextSiblingCountChange
+    end
+    object cdsOrgBillsIsIgNore: TBooleanField
+      FieldName = 'IsIgNore'
+      OnChange = cdsOrgBillsLostNextSiblingCountChange
+    end
+    object cdsOrgBillsDeductGrade: TFloatField
+      FieldName = 'DeductGrade'
+      OnChange = cdsOrgBillsLostNextSiblingCountChange
+      OnGetText = cdsOrgBillsDeductGradeGetText
+    end
+    object cdsOrgBillsStandardGrade: TFloatField
+      FieldName = 'StandardGrade'
+      OnChange = cdsOrgBillsLostNextSiblingCountChange
+    end
+    object cdsOrgBillsIsSuperscale: TBooleanField
+      FieldName = 'IsSuperscale'
+      OnChange = cdsOrgBillsLostNextSiblingCountChange
+    end
+    object cdsOrgBillsErrorHint: TWideStringField
+      FieldName = 'ErrorHint'
+      OnChange = cdsOrgBillsLostNextSiblingCountChange
+      Size = 255
+    end
+    object cdsOrgBillsNameErrorFlag: TIntegerField
+      FieldName = 'NameErrorFlag'
+      OnChange = cdsOrgBillsLostNextSiblingCountChange
+    end
+    object cdsOrgBillsUnitsErrorFlag: TIntegerField
+      FieldName = 'UnitsErrorFlag'
+      OnChange = cdsOrgBillsLostNextSiblingCountChange
+    end
+    object cdsOrgBillsRightUnits: TWideStringField
+      FieldName = 'RightUnits'
+      Size = 255
+    end
+    object cdsOrgBillsIsLeaf: TBooleanField
+      FieldName = 'IsLeaf'
+    end
+    object cdsOrgBillsRightName: TWideStringField
+      FieldName = 'RightName'
+      Size = 255
+    end
+    object cdsOrgBillsIsCreatePriceAnalysis: TBooleanField
+      FieldName = 'IsCreatePriceAnalysis'
+    end
+    object cdsOrgBillsDrawingCode: TWideStringField
+      FieldName = 'DrawingCode'
+      Size = 50
+    end
+    object cdsOrgBillsIsAccQuantity: TBooleanField
+      FieldName = 'IsAccQuantity'
+      OnChange = cdsOrgBillsIsAccQuantityChange
+    end
+  end
+  object cdsOrgDrawingQuantity: TClientDataSet
+    Aggregates = <>
+    MasterSource = dsBillsDrawing
+    PacketRecords = 0
+    Params = <>
+    AfterInsert = cdsOrgDrawingQuantityAfterInsert
+    BeforeEdit = cdsOrgDrawingQuantityBeforeEdit
+    BeforePost = cdsOrgDrawingQuantityBeforePost
+    AfterPost = cdsOrgDrawingQuantityAfterPost
+    BeforeDelete = cdsOrgDrawingQuantityBeforeDelete
+    AfterDelete = cdsOrgDrawingQuantityAfterDelete
+    Left = 284
+    Top = 312
+    object cdsOrgDrawingQuantityID: TIntegerField
+      FieldName = 'ID'
+    end
+    object cdsOrgDrawingQuantityName: TWideStringField
+      FieldName = 'Name'
+      Size = 200
+    end
+    object cdsOrgDrawingQuantityUnits: TWideStringField
+      FieldName = 'Units'
+      Size = 50
+    end
+    object cdsOrgDrawingQuantityBillsID: TIntegerField
+      FieldName = 'BillsID'
+    end
+    object cdsOrgDrawingQuantityDQuantity1: TFloatField
+      FieldName = 'DQuantity1'
+      OnChange = cdsOrgBillsCodeChange
+      OnGetText = cdsOrgDrawingQuantityDQuantity1GetText
+      OnSetText = cdsOrgDrawingQuantityDQuantity1SetText
+    end
+    object cdsOrgDrawingQuantityMemoContext: TWideStringField
+      FieldName = 'MemoContext'
+      Size = 200
+    end
+    object cdsOrgDrawingQuantitySerinalNo: TIntegerField
+      FieldName = 'SerinalNo'
+    end
+    object cdsOrgDrawingQuantityIsGatherQ: TBooleanField
+      FieldName = 'IsGatherQ'
+      OnChange = cdsOrgBillsCodeChange
+    end
+  end
+  object cdsDQForLocate: TClientDataSet
+    Aggregates = <>
+    Params = <>
+    Left = 282
+    Top = 190
+    object cdsDQForLocateID: TIntegerField
+      FieldName = 'ID'
+    end
+    object cdsDQForLocateBillsID: TIntegerField
+      FieldName = 'BillsID'
+    end
+    object cdsDQForLocateName: TWideStringField
+      FieldName = 'Name'
+      Size = 200
+    end
+    object cdsDQForLocateUnits: TWideStringField
+      FieldName = 'Units'
+      Size = 50
+    end
+    object cdsDQForLocateMemoContext: TWideStringField
+      FieldName = 'MemoContext'
+      Size = 200
+    end
+    object cdsDQForLocateDQuantity1: TFloatField
+      FieldName = 'DQuantity1'
+    end
+    object cdsDQForLocateDQuantity2: TFloatField
+      FieldName = 'DQuantity2'
+    end
+    object cdsDQForLocateSerinalNo: TIntegerField
+      FieldName = 'SerinalNo'
+    end
+    object cdsDQForLocateIsGatherQ: TBooleanField
+      FieldName = 'IsGatherQ'
+    end
+  end
+  object cdsXMJBills: TClientDataSet
+    Aggregates = <>
+    Params = <>
+    AfterScroll = cdsXMJBillsAfterScroll
+    Left = 40
+    Top = 386
+    object cdsXMJBillsQuantity: TFloatField
+      FieldName = 'Quantity'
+      OnGetText = cdsXMJBillsQuantityGetText
+    end
+    object cdsXMJBillsUnitPrice: TBCDField
+      FieldName = 'UnitPrice'
+      OnGetText = cdsXMJBillsQuantityGetText
+      Precision = 19
+    end
+    object cdsXMJBillsID: TIntegerField
+      FieldName = 'ID'
+    end
+    object cdsXMJBillsParentID: TIntegerField
+      FieldName = 'ParentID'
+    end
+    object cdsXMJBillsNextSiblingID: TIntegerField
+      FieldName = 'NextSiblingID'
+    end
+    object cdsXMJBillsCode: TWideStringField
+      FieldName = 'Code'
+      Size = 50
+    end
+    object cdsXMJBillsName: TWideStringField
+      FieldName = 'Name'
+      Size = 128
+    end
+    object cdsXMJBillsUnits: TWideStringField
+      FieldName = 'Units'
+      Size = 50
+    end
+    object cdsXMJBillsB_Code: TWideStringField
+      FieldName = 'B_Code'
+      Size = 255
+    end
+    object cdsXMJBillsMemoStr: TMemoField
+      FieldName = 'MemoStr'
+      BlobType = ftMemo
+    end
+    object cdsXMJBillsTotalPrice: TBCDField
+      FieldName = 'TotalPrice'
+      OnGetText = cdsXMJBillsQuantityGetText
+      Precision = 19
+    end
+    object cdsXMJBillsDesignQuantity: TFloatField
+      FieldName = 'DesignQuantity'
+      OnGetText = cdsXMJBillsQuantityGetText
+    end
+    object cdsXMJBillsDesignQuantity2: TFloatField
+      FieldName = 'DesignQuantity2'
+      OnGetText = cdsXMJBillsQuantityGetText
+    end
+    object cdsXMJBillsDesignPrice: TFloatField
+      FieldName = 'DesignPrice'
+      OnGetText = cdsXMJBillsQuantityGetText
+    end
+    object cdsXMJBillsSelected: TBooleanField
+      FieldName = 'Selected'
+    end
+    object cdsXMJBillsChapterID: TIntegerField
+      FieldName = 'ChapterID'
+    end
+    object cdsXMJBillsIsPreDefine: TBooleanField
+      FieldName = 'IsPreDefine'
+    end
+    object cdsXMJBillsUnitsErrorFlag: TIntegerField
+      FieldName = 'UnitsErrorFlag'
+      OnChange = cdsOrgBillsLostNextSiblingCountChange
+    end
+    object cdsXMJBillsNameErrorFlag: TIntegerField
+      FieldName = 'NameErrorFlag'
+      OnChange = cdsOrgBillsLostNextSiblingCountChange
+    end
+    object cdsXMJBillsErrorHint: TWideStringField
+      FieldName = 'ErrorHint'
+      OnChange = cdsOrgBillsLostNextSiblingCountChange
+      Size = 255
+    end
+    object cdsXMJBillsIsSuperscale: TBooleanField
+      FieldName = 'IsSuperscale'
+      OnChange = cdsOrgBillsLostNextSiblingCountChange
+    end
+    object cdsXMJBillsStandardGrade: TFloatField
+      FieldName = 'StandardGrade'
+      OnChange = cdsOrgBillsLostNextSiblingCountChange
+    end
+    object cdsXMJBillsDeductGrade: TFloatField
+      FieldName = 'DeductGrade'
+      OnChange = cdsOrgBillsLostNextSiblingCountChange
+      OnGetText = cdsOrgBillsDeductGradeGetText
+    end
+    object cdsXMJBillsIsIgNore: TBooleanField
+      FieldName = 'IsIgNore'
+      OnChange = cdsOrgBillsLostNextSiblingCountChange
+    end
+    object cdsXMJBillsUserModified: TBooleanField
+      FieldName = 'UserModified'
+      OnChange = cdsOrgBillsLostNextSiblingCountChange
+    end
+    object cdsXMJBillsLostPreSiblingCount: TIntegerField
+      FieldName = 'LostPreSiblingCount'
+      OnChange = cdsOrgBillsLostNextSiblingCountChange
+    end
+    object cdsXMJBillsLostChildrenCount: TIntegerField
+      FieldName = 'LostChildrenCount'
+      OnChange = cdsOrgBillsLostNextSiblingCountChange
+    end
+    object cdsXMJBillsLostNextSiblingCount: TIntegerField
+      FieldName = 'LostNextSiblingCount'
+      OnChange = cdsOrgBillsLostNextSiblingCountChange
+    end
+    object cdsXMJBillsRightName: TWideStringField
+      FieldName = 'RightName'
+      Size = 255
+    end
+    object cdsXMJBillsRightUnits: TWideStringField
+      FieldName = 'RightUnits'
+      Size = 255
+    end
+    object blnfldXMJBillsIsAccQuantity: TBooleanField
+      FieldName = 'IsAccQuantity'
+    end
+  end
+  object cdsBillsLookup: TClientDataSet
+    Aggregates = <>
+    Params = <>
+    ProviderName = 'dspBills'
+    Left = 33
+    Top = 256
+    object cdsBillsLookupID: TIntegerField
+      FieldName = 'ID'
+    end
+    object cdsBillsLookupParentID: TIntegerField
+      FieldName = 'ParentID'
+    end
+    object cdsBillsLookupNextSiblingID: TIntegerField
+      FieldName = 'NextSiblingID'
+    end
+    object cdsBillsLookupCode: TWideStringField
+      FieldName = 'Code'
+      Size = 50
+    end
+    object cdsBillsLookupName: TWideStringField
+      FieldName = 'Name'
+      Size = 128
+    end
+    object cdsBillsLookupUnits: TWideStringField
+      FieldName = 'Units'
+      Size = 50
+    end
+    object cdsBillsLookupQuantity: TFloatField
+      FieldName = 'Quantity'
+    end
+    object cdsBillsLookupUnitPrice: TBCDField
+      FieldName = 'UnitPrice'
+      Precision = 19
+    end
+    object cdsBillsLookupTotalPrice: TBCDField
+      FieldName = 'TotalPrice'
+      Precision = 19
+    end
+    object cdsBillsLookupB_Code: TWideStringField
+      FieldName = 'B_Code'
+      Size = 255
+    end
+    object cdsBillsLookupDesignQuantity: TFloatField
+      FieldName = 'DesignQuantity'
+    end
+    object cdsBillsLookupDesignQuantity2: TFloatField
+      FieldName = 'DesignQuantity2'
+    end
+    object cdsBillsLookupDesignPrice: TFloatField
+      FieldName = 'DesignPrice'
+    end
+    object cdsBillsLookupMemoStr: TMemoField
+      FieldName = 'MemoStr'
+      BlobType = ftMemo
+    end
+    object cdsBillsLookupIsPreDefine: TBooleanField
+      FieldName = 'IsPreDefine'
+    end
+    object cdsBillsLookupSelected: TBooleanField
+      FieldName = 'Selected'
+    end
+    object cdsBillsLookupCustomValue: TFloatField
+      FieldName = 'CustomValue'
+    end
+    object cdsBillsLookupSerialNo: TIntegerField
+      FieldName = 'SerialNo'
+    end
+    object cdsBillsLookupLostNextSiblingCount: TIntegerField
+      FieldName = 'LostNextSiblingCount'
+    end
+    object cdsBillsLookupLostChildrenCount: TIntegerField
+      FieldName = 'LostChildrenCount'
+    end
+    object cdsBillsLookupLostPreSiblingCount: TIntegerField
+      FieldName = 'LostPreSiblingCount'
+    end
+    object cdsBillsLookupUserModified: TBooleanField
+      FieldName = 'UserModified'
+    end
+    object cdsBillsLookupIsIgNore: TBooleanField
+      FieldName = 'IsIgNore'
+    end
+    object cdsBillsLookupDeductGrade: TFloatField
+      FieldName = 'DeductGrade'
+    end
+    object cdsBillsLookupStandardGrade: TFloatField
+      FieldName = 'StandardGrade'
+    end
+    object cdsBillsLookupIsSuperscale: TBooleanField
+      FieldName = 'IsSuperscale'
+    end
+    object cdsBillsLookupErrorHint: TWideStringField
+      FieldName = 'ErrorHint'
+      Size = 255
+    end
+    object cdsBillsLookupNameErrorFlag: TIntegerField
+      FieldName = 'NameErrorFlag'
+    end
+    object cdsBillsLookupUnitsErrorFlag: TIntegerField
+      FieldName = 'UnitsErrorFlag'
+    end
+    object cdsBillsLookupDrawingCode: TWideStringField
+      FieldName = 'DrawingCode'
+      Size = 50
+    end
+    object cdsBillsLookupIsAccQuantity: TBooleanField
+      FieldName = 'IsAccQuantity'
+    end
+  end
+  object aqStat: TADOQuery
+    OnCalcFields = aqStatCalcFields
+    Parameters = <>
+    SQL.Strings = (
+      'Select T3.*, T4.YsCount, T4.QdCount from'
+      '(Select T1.*, T2.StandardGrade, T2.DeductGrade from'
+      
+        '(Select ChapterID, Code, Name from Bills where (Len(Code) <= 4) ' +
+        'and (Left(Code, 2) = '#39'1-'#39')) as T1,'
+      
+        '(Select ChapterID, Sum(StandardGrade) as StandardGrade, Sum(Dedu' +
+        'ctGrade) as DeductGrade from Bills '
+      'where'
+      'IsIgnore <> True Group by ChapterID) as T2'
+      'where T1.ChapterID = T2.ChapterID) as T3'
+      'left join'
+      
+        '(Select ChapterID, Count(Code) as YsCount, Count(B_Code) as QdCo' +
+        'unt from Bills where IsIgnore <> True and'
+      'IsSuperscale = True Group by ChapterID) as T4'
+      'on T3.ChapterID = T4.ChapterID'
+      'order by T3.ChapterID')
+    Left = 408
+    Top = 520
+    object aqStatChapterID: TIntegerField
+      FieldName = 'ChapterID'
+    end
+    object aqStatCode: TWideStringField
+      FieldName = 'Code'
+      Size = 50
+    end
+    object aqStatName: TWideStringField
+      FieldName = 'Name'
+      Size = 128
+    end
+    object aqStatStandardGrade: TFloatField
+      FieldName = 'StandardGrade'
+    end
+    object aqStatDeductGrade: TFloatField
+      FieldName = 'DeductGrade'
+    end
+    object aqStatActureMark: TCurrencyField
+      FieldKind = fkCalculated
+      FieldName = 'ActureMark'
+      currency = False
+      Calculated = True
+    end
+    object aqStatTotalMark: TCurrencyField
+      FieldKind = fkCalculated
+      FieldName = 'TotalMark'
+      currency = False
+      Calculated = True
+    end
+    object aqStatResultMark: TCurrencyField
+      FieldKind = fkCalculated
+      FieldName = 'ResultMark'
+      currency = False
+      Calculated = True
+    end
+    object aqStatStdMarkPercent: TBCDField
+      FieldKind = fkCalculated
+      FieldName = 'StdMarkPercent'
+      Calculated = True
+    end
+    object aqStatYsCount: TIntegerField
+      FieldName = 'YsCount'
+    end
+    object aqStatQdCount: TIntegerField
+      FieldName = 'QdCount'
+    end
+  end
+  object cdsStat: TClientDataSet
+    Aggregates = <>
+    IndexFieldNames = 'Code'
+    Params = <>
+    ProviderName = 'dspStat'
+    Left = 220
+    Top = 520
+    object cdsStatChapterID: TIntegerField
+      FieldName = 'ChapterID'
+    end
+    object cdsStatCode: TWideStringField
+      FieldName = 'Code'
+      Size = 50
+    end
+    object cdsStatName: TWideStringField
+      FieldName = 'Name'
+      Size = 128
+    end
+    object cdsStatStandardGrade: TBCDField
+      FieldName = 'StandardGrade'
+    end
+    object cdsStatDeductGrade: TBCDField
+      FieldName = 'DeductGrade'
+    end
+    object cdsStatActureMark: TBCDField
+      FieldName = 'ActureMark'
+    end
+    object cdsStatTotalMark: TBCDField
+      FieldName = 'TotalMark'
+    end
+    object cdsStatResultMark: TBCDField
+      FieldName = 'ResultMark'
+    end
+    object cdsStatStdMarkPercent: TBCDField
+      FieldName = 'StdMarkPercent'
+    end
+    object cdsStatYsCount: TIntegerField
+      FieldName = 'YsCount'
+    end
+    object cdsStatQdCount: TIntegerField
+      FieldName = 'QdCount'
+    end
+  end
+  object dsStat: TDataSource
+    DataSet = cdsStat
+    Left = 314
+    Top = 520
+  end
+  object atStat: TADOTable
+    TableName = 'GradeStat'
+    Left = 32
+    Top = 520
+  end
+  object dspStat: TDataSetProvider
+    DataSet = atStat
+    UpdateMode = upWhereKeyOnly
+    Left = 126
+    Top = 520
+  end
+  object acProject: TADOConnection
+    Left = 288
+    Top = 56
+  end
+  object cdsStatTotal: TClientDataSet
+    Aggregates = <>
+    Params = <>
+    ProviderName = 'dspStatTotal'
+    Left = 220
+    Top = 464
+    object cdsStatTotalID: TIntegerField
+      FieldName = 'ID'
+    end
+    object cdsStatTotalStandardGradeTotal: TBCDField
+      FieldName = 'StandardGradeTotal'
+    end
+    object cdsStatTotalDeductGradeTotal: TBCDField
+      FieldName = 'DeductGradeTotal'
+    end
+    object cdsStatTotalResultMarkTotal: TBCDField
+      FieldName = 'ResultMarkTotal'
+    end
+    object cdsStatTotalAdditionalMark: TBCDField
+      FieldName = 'AdditionalMark'
+    end
+    object cdsStatTotalQualityMark: TBCDField
+      FieldName = 'QualityMark'
+    end
+    object cdsStatTotalYsCountTotal: TIntegerField
+      FieldName = 'YsCountTotal'
+    end
+    object cdsStatTotalQdCountTotal: TIntegerField
+      FieldName = 'QdCountTotal'
+    end
+  end
+  object atStatTotal: TADOTable
+    TableName = 'GradeStatTotal'
+    Left = 32
+    Top = 464
+  end
+  object dspStatTotal: TDataSetProvider
+    DataSet = atStatTotal
+    UpdateMode = upWhereKeyOnly
+    Left = 126
+    Top = 464
+  end
+  object aqStatTotal: TADOQuery
+    OnCalcFields = aqStatTotalCalcFields
+    Parameters = <>
+    SQL.Strings = (
+      'Select T1.*, T2.* from'
+      
+        '(Select 1 as ID, Sum(StandardGrade) as StandardGradeTotal, Sum(D' +
+        'eductGrade) as DeductGradeTotal from Bills where IsIgnore <> Tru' +
+        'e) as T1,'
+      
+        '(Select Count(Code) as YsCountTotal, Count(B_Code) as QdCountTot' +
+        'al from Bills'
+      'where IsIgnore <> True and IsSuperscale = True) as T2')
+    Left = 312
+    Top = 464
+    object aqStatTotalID: TIntegerField
+      FieldName = 'ID'
+    end
+    object aqStatTotalStandardGradeTotal: TBCDField
+      FieldName = 'StandardGradeTotal'
+    end
+    object aqStatTotalDeductGradeTotal: TBCDField
+      FieldName = 'DeductGradeTotal'
+    end
+    object aqStatTotalYsCountTotal: TIntegerField
+      FieldName = 'YsCountTotal'
+    end
+    object aqStatTotalQdCountTotal: TIntegerField
+      FieldName = 'QdCountTotal'
+    end
+    object aqStatTotalResultMarkTotal: TBCDField
+      FieldKind = fkCalculated
+      FieldName = 'ResultMarkTotal'
+      Calculated = True
+    end
+    object aqStatTotalAdditionalMark: TBCDField
+      FieldKind = fkCalculated
+      FieldName = 'AdditionalMark'
+      Calculated = True
+    end
+    object aqStatTotalQualityMark: TBCDField
+      FieldKind = fkCalculated
+      FieldName = 'QualityMark'
+      Calculated = True
+    end
+  end
+end

Разница между файлами не показана из-за своего большого размера
+ 4769 - 0
DB/DataBase.pas


+ 435 - 0
DB/DetailItemsDM.dfm

@@ -0,0 +1,435 @@
+object DMDetailItems: TDMDetailItems
+  OldCreateOrder = False
+  OnCreate = DataModuleCreate
+  Left = 262
+  Top = 224
+  Height = 287
+  Width = 696
+  object cdsPPItems: TClientDataSet
+    Active = True
+    Aggregates = <>
+    Params = <>
+    AfterScroll = cdsPPItemsAfterScroll
+    Left = 42
+    Top = 160
+    Data = {
+      B70000009619E0BD010000001800000008000000000003000000B70002494404
+      0001000000000004436F646501004A0000000100055749445448020002006400
+      044E616D6502004A000000010005574944544802000200900105556E69747301
+      004A0000000100055749445448020002002800085175616E7469747908000400
+      0000000009556E6974507269636508000400000000000A546F74616C50726963
+      6508000400000000000742696C6C73494404000100000000000000}
+    object cdsPPItemsID: TIntegerField
+      FieldName = 'ID'
+    end
+    object cdsPPItemsCode: TWideStringField
+      FieldName = 'Code'
+      Size = 50
+    end
+    object cdsPPItemsName: TWideStringField
+      FieldName = 'Name'
+      Size = 200
+    end
+    object cdsPPItemsUnits: TWideStringField
+      FieldName = 'Units'
+    end
+    object cdsPPItemsQuantity: TFloatField
+      FieldName = 'Quantity'
+      OnGetText = cdsPQBillsQuantityGetText
+    end
+    object cdsPPItemsUnitPrice: TFloatField
+      FieldName = 'UnitPrice'
+      OnGetText = cdsPQBillsQuantityGetText
+    end
+    object cdsPPItemsTotalPrice: TFloatField
+      FieldName = 'TotalPrice'
+      OnGetText = cdsPQBillsQuantityGetText
+    end
+    object cdsPPItemsBillsID: TIntegerField
+      FieldName = 'BillsID'
+    end
+  end
+  object cdsPPDrawQty: TClientDataSet
+    Active = True
+    Aggregates = <>
+    FieldDefs = <
+      item
+        Name = 'Name'
+        DataType = ftWideString
+        Size = 200
+      end
+      item
+        Name = 'Units'
+        DataType = ftWideString
+        Size = 20
+      end
+      item
+        Name = 'Quantity'
+        DataType = ftFloat
+      end
+      item
+        Name = 'DesignQuantity'
+        DataType = ftFloat
+      end
+      item
+        Name = 'MemoStr'
+        DataType = ftWideString
+        Size = 200
+      end
+      item
+        Name = 'BillsID'
+        DataType = ftInteger
+      end
+      item
+        Name = 'SerialNo'
+        DataType = ftInteger
+      end
+      item
+        Name = 'DQID'
+        DataType = ftInteger
+      end>
+    IndexDefs = <>
+    Params = <>
+    StoreDefs = True
+    BeforePost = cdsPPDrawQtyBeforePost
+    Left = 243
+    Top = 158
+    Data = {
+      BF0000009619E0BD010000001800000008000000000003000000BF00044E616D
+      6502004A000000010005574944544802000200900105556E69747301004A0000
+      000100055749445448020002002800085175616E746974790800040000000000
+      0E44657369676E5175616E746974790800040000000000074D656D6F53747202
+      004A00000001000557494454480200020090010742696C6C7349440400010000
+      0000000853657269616C4E6F0400010000000000044451494404000100000000
+      000000}
+    object cdsPPDrawQtyName: TWideStringField
+      FieldName = 'Name'
+      Size = 200
+    end
+    object cdsPPDrawQtyUnits: TWideStringField
+      FieldName = 'Units'
+    end
+    object cdsPPDrawQtyQuantity: TFloatField
+      FieldName = 'Quantity'
+      OnChange = cdsPPDrawQtyQuantityChange
+      OnGetText = cdsPQBillsQuantityGetText
+    end
+    object cdsPPDrawQtyDesignQuantity: TFloatField
+      FieldName = 'DesignQuantity'
+      OnGetText = cdsPQBillsQuantityGetText
+    end
+    object cdsPPDrawQtyMemoStr: TWideStringField
+      FieldName = 'MemoStr'
+      Size = 200
+    end
+    object cdsPPDrawQtyBillsID: TIntegerField
+      FieldName = 'BillsID'
+    end
+    object cdsPPDrawQtySerialNo: TIntegerField
+      FieldName = 'SerialNo'
+    end
+    object cdsPPDrawQtyDQID: TIntegerField
+      FieldName = 'DQID'
+    end
+  end
+  object cdsPPDetailItems: TClientDataSet
+    Active = True
+    Aggregates = <>
+    Params = <>
+    AfterScroll = cdsPPDetailItemsAfterScroll
+    Left = 138
+    Top = 159
+    Data = {
+      B60000009619E0BD010000001800000008000000000003000000B60002494404
+      0001000000000004436F646501004A0000000100055749445448020002006400
+      044E616D6502004A000000010005574944544802000200900105556E69747301
+      004A0000000100055749445448020002002800085175616E7469747908000400
+      0000000009556E6974507269636508000400000000000A546F74616C50726963
+      650800040000000000064974656D494404000100000000000000}
+    object cdsPPDetailItemsID: TIntegerField
+      FieldName = 'ID'
+    end
+    object cdsPPDetailItemsCode: TWideStringField
+      FieldName = 'Code'
+      Size = 50
+    end
+    object cdsPPDetailItemsName: TWideStringField
+      FieldName = 'Name'
+      Size = 200
+    end
+    object cdsPPDetailItemsUnits: TWideStringField
+      FieldName = 'Units'
+    end
+    object cdsPPDetailItemsQuantity: TFloatField
+      FieldName = 'Quantity'
+      OnGetText = cdsPQBillsQuantityGetText
+    end
+    object cdsPPDetailItemsUnitPrice: TFloatField
+      FieldName = 'UnitPrice'
+      OnGetText = cdsPQBillsQuantityGetText
+    end
+    object cdsPPDetailItemsTotalPrice: TFloatField
+      FieldName = 'TotalPrice'
+      OnGetText = cdsPQBillsQuantityGetText
+    end
+    object cdsPPDetailItemsItemID: TIntegerField
+      FieldName = 'ItemID'
+    end
+  end
+  object cdsPQBills: TClientDataSet
+    Active = True
+    Aggregates = <>
+    Params = <>
+    AfterScroll = cdsPQBillsAfterScroll
+    Left = 474
+    Top = 56
+    Data = {
+      020100009619E0BD010000001800000008000000000003000000020102494404
+      0001000000000006425F436F646501004A000000010005574944544802000200
+      6400044E616D6502004A000000010005574944544802000200900105556E6974
+      7301004A0000000100055749445448020002006400085175616E746974790800
+      04000000000009556E697450726963650C0005000000020008444543494D414C
+      530200020004000557494454480200020013000A546F74616C50726963650C00
+      05000000020008444543494D414C530200020004000557494454480200020013
+      00074D656D6F53747204004B0000000100075355425459504502004900050054
+      657874000000}
+    object cdsPQBillsID: TIntegerField
+      FieldName = 'ID'
+    end
+    object cdsPQBillsCode: TWideStringField
+      FieldName = 'B_Code'
+      Size = 50
+    end
+    object cdsPQBillsName: TWideStringField
+      FieldName = 'Name'
+      Size = 200
+    end
+    object cdsPQBillsUnits: TWideStringField
+      FieldName = 'Units'
+      Size = 50
+    end
+    object cdsPQBillsQuantity: TFloatField
+      FieldName = 'Quantity'
+      OnGetText = cdsPQBillsQuantityGetText
+    end
+    object cdsPQBillsUnitPrice: TBCDField
+      FieldName = 'UnitPrice'
+      OnGetText = cdsPQBillsQuantityGetText
+      Precision = 19
+    end
+    object cdsPQBillsTotalPrice: TBCDField
+      FieldName = 'TotalPrice'
+      OnGetText = cdsPQBillsQuantityGetText
+      Precision = 19
+    end
+    object cdsPQBillsMemoStr: TMemoField
+      FieldName = 'MemoStr'
+      BlobType = ftMemo
+    end
+  end
+  object cdsBills: TClientDataSet
+    Aggregates = <>
+    Params = <>
+    Left = 416
+    Top = 56
+    object cdsBillsCode: TWideStringField
+      FieldName = 'Code'
+      Size = 50
+    end
+    object cdsBillsB_Code: TWideStringField
+      FieldName = 'B_Code'
+      Size = 50
+    end
+    object cdsBillsName: TWideStringField
+      FieldName = 'Name'
+      Size = 200
+    end
+    object cdsBillsUnits: TWideStringField
+      FieldName = 'Units'
+      Size = 50
+    end
+    object cdsBillsQuantity: TFloatField
+      FieldName = 'Quantity'
+    end
+    object cdsBillsUnitPrice: TBCDField
+      FieldName = 'UnitPrice'
+      Precision = 19
+    end
+    object cdsBillsTotalPrice: TBCDField
+      FieldName = 'TotalPrice'
+      Precision = 19
+    end
+    object cdsBillsMemoStr: TMemoField
+      FieldName = 'MemoStr'
+      BlobType = ftMemo
+    end
+  end
+  object cdsQIItems: TClientDataSet
+    Active = True
+    Aggregates = <>
+    Params = <>
+    AfterScroll = cdsQIItemsAfterScroll
+    Left = 416
+    Top = 158
+    Data = {
+      B70000009619E0BD010000001800000008000000000003000000B70002494404
+      0001000000000004436F646501004A0000000100055749445448020002006400
+      044E616D6502004A000000010005574944544802000200900105556E69747301
+      004A0000000100055749445448020002002800085175616E7469747908000400
+      0000000009556E6974507269636508000400000000000A546F74616C50726963
+      6508000400000000000742696C6C73494404000100000000000000}
+    object cdsQIItemsID: TIntegerField
+      FieldName = 'ID'
+    end
+    object cdsQIItemsCode: TWideStringField
+      FieldName = 'Code'
+      Size = 50
+    end
+    object cdsQIItemsName: TWideStringField
+      FieldName = 'Name'
+      Size = 200
+    end
+    object cdsQIItemsUnits: TWideStringField
+      FieldName = 'Units'
+    end
+    object cdsQIItemsQuantity: TFloatField
+      FieldName = 'Quantity'
+      OnGetText = cdsPQBillsQuantityGetText
+    end
+    object cdsQIItemsUnitPrice: TFloatField
+      FieldName = 'UnitPrice'
+      OnGetText = cdsPQBillsQuantityGetText
+    end
+    object cdsQIItemsTotalPrice: TFloatField
+      FieldName = 'TotalPrice'
+      OnGetText = cdsPQBillsQuantityGetText
+    end
+    object cdsQIItemsBillsID: TIntegerField
+      FieldName = 'BillsID'
+    end
+  end
+  object cdsQIDetailItems: TClientDataSet
+    Active = True
+    Aggregates = <>
+    Params = <>
+    Left = 496
+    Top = 158
+    Data = {
+      B60000009619E0BD010000001800000008000000000003000000B60002494404
+      0001000000000004436F646501004A0000000100055749445448020002006400
+      044E616D6502004A000000010005574944544802000200900105556E69747301
+      004A0000000100055749445448020002002800085175616E7469747908000400
+      0000000009556E6974507269636508000400000000000A546F74616C50726963
+      650800040000000000064974656D494404000100000000000000}
+    object cdsQIDetailItemsID: TIntegerField
+      FieldName = 'ID'
+    end
+    object cdsQIDetailItemsCode: TWideStringField
+      FieldName = 'Code'
+      Size = 50
+    end
+    object cdsQIDetailItemsName: TWideStringField
+      FieldName = 'Name'
+      Size = 200
+    end
+    object cdsQIDetailItemsUnits: TWideStringField
+      FieldName = 'Units'
+    end
+    object cdsQIDetailItemsQuantity: TFloatField
+      FieldName = 'Quantity'
+      OnChange = cdsPPDrawQtyQuantityChange
+    end
+    object cdsQIDetailItemsUnitPrice: TFloatField
+      FieldName = 'UnitPrice'
+      OnChange = cdsPPDrawQtyQuantityChange
+    end
+    object cdsQIDetailItemsTotalPrice: TFloatField
+      FieldName = 'TotalPrice'
+      OnChange = cdsPPDrawQtyQuantityChange
+    end
+    object cdsQIDetailItemsItemID: TIntegerField
+      FieldName = 'ItemID'
+    end
+  end
+  object cdsQIDrawQty: TClientDataSet
+    Active = True
+    Aggregates = <>
+    FieldDefs = <
+      item
+        Name = 'Name'
+        DataType = ftWideString
+        Size = 200
+      end
+      item
+        Name = 'Units'
+        DataType = ftWideString
+        Size = 20
+      end
+      item
+        Name = 'Quantity'
+        DataType = ftFloat
+      end
+      item
+        Name = 'DesignQuantity'
+        DataType = ftFloat
+      end
+      item
+        Name = 'MemoStr'
+        DataType = ftWideString
+        Size = 200
+      end
+      item
+        Name = 'BillsID'
+        DataType = ftInteger
+      end
+      item
+        Name = 'SerialNo'
+        DataType = ftInteger
+      end
+      item
+        Name = 'DQID'
+        DataType = ftInteger
+      end>
+    IndexDefs = <>
+    Params = <>
+    StoreDefs = True
+    Left = 582
+    Top = 158
+    Data = {
+      BF0000009619E0BD010000001800000008000000000003000000BF00044E616D
+      6502004A000000010005574944544802000200900105556E69747301004A0000
+      000100055749445448020002002800085175616E746974790800040000000000
+      0E44657369676E5175616E746974790800040000000000074D656D6F53747202
+      004A00000001000557494454480200020090010742696C6C7349440400010000
+      0000000853657269616C4E6F0400010000000000044451494404000100000000
+      000000}
+    object cdsQIDrawQtyName: TWideStringField
+      FieldName = 'Name'
+      Size = 200
+    end
+    object cdsQIDrawQtyUnits: TWideStringField
+      FieldName = 'Units'
+    end
+    object cdsQIDrawQtyQuantity: TFloatField
+      FieldName = 'Quantity'
+      OnGetText = cdsPQBillsQuantityGetText
+    end
+    object cdsQIDrawQtyDesignQuantity: TFloatField
+      FieldName = 'DesignQuantity'
+      OnGetText = cdsPQBillsQuantityGetText
+    end
+    object cdsQIDrawQtyMemoStr: TWideStringField
+      FieldName = 'MemoStr'
+      Size = 200
+    end
+    object cdsQIDrawQtyBillsID: TIntegerField
+      FieldName = 'BillsID'
+    end
+    object cdsQIDrawQtySerialNo: TIntegerField
+      FieldName = 'SerialNo'
+    end
+    object cdsQIDrawQtyDQID: TIntegerField
+      FieldName = 'DQID'
+    end
+  end
+end

Разница между файлами не показана из-за своего большого размера
+ 1027 - 0
DB/DetailItemsDM.pas


+ 173 - 0
DB/HisRestorePointDM.dfm

@@ -0,0 +1,173 @@
+object DMHisRestorePoint: TDMHisRestorePoint
+  OldCreateOrder = False
+  OnCreate = DataModuleCreate
+  Left = 508
+  Top = 263
+  Height = 304
+  Width = 509
+  object cdsOrgHisPoint: TClientDataSet
+    Aggregates = <>
+    Params = <>
+    ProviderName = 'dspHisRestorePoint'
+    Left = 72
+    Top = 168
+    object cdsOrgHisPointID: TIntegerField
+      FieldName = 'ID'
+    end
+    object cdsOrgHisPointFixed: TBooleanField
+      FieldName = 'Fixed'
+    end
+    object cdsOrgHisPointFileName: TWideStringField
+      FieldName = 'FileName'
+      Size = 100
+    end
+    object cdsOrgHisPointFileDir: TWideStringField
+      FieldName = 'FileDir'
+      Size = 200
+    end
+    object cdsOrgHisPointCreateTime: TDateTimeField
+      FieldName = 'CreateTime'
+    end
+  end
+  object cdsUnFixedPoint: TClientDataSet
+    Active = True
+    Aggregates = <>
+    FieldDefs = <
+      item
+        Name = 'ID'
+        DataType = ftInteger
+      end
+      item
+        Name = 'Fixed'
+        DataType = ftBoolean
+      end
+      item
+        Name = 'FileName'
+        DataType = ftWideString
+        Size = 100
+      end
+      item
+        Name = 'FileDir'
+        DataType = ftWideString
+        Size = 200
+      end
+      item
+        Name = 'IsExists'
+        DataType = ftWideString
+        Size = 2
+      end
+      item
+        Name = 'CreateTime'
+        DataType = ftDateTime
+      end>
+    IndexDefs = <>
+    Params = <>
+    StoreDefs = True
+    BeforeDelete = cdsUnFixedPointBeforeDelete
+    Left = 286
+    Top = 37
+    Data = {
+      9C0000009619E0BD0100000018000000060000000000030000009C0002494404
+      0001000000000005466978656402000300000000000846696C654E616D650100
+      4A000000010005574944544802000200C8000746696C6544697202004A000000
+      010005574944544802000200900108497345786973747301004A000000010005
+      57494454480200020004000A43726561746554696D6508000800000000000000}
+    object cdsUnFixedPointID: TIntegerField
+      FieldName = 'ID'
+    end
+    object cdsUnFixedPointFixed: TBooleanField
+      FieldName = 'Fixed'
+    end
+    object cdsUnFixedPointFileName: TWideStringField
+      FieldName = 'FileName'
+      Size = 100
+    end
+    object cdsUnFixedPointFileDir: TWideStringField
+      FieldName = 'FileDir'
+      Size = 200
+    end
+    object cdsUnFixedPointIsExists: TWideStringField
+      FieldName = 'IsExists'
+      Size = 2
+    end
+    object cdsUnFixedPointCreateTime: TDateTimeField
+      FieldName = 'CreateTime'
+    end
+  end
+  object cdsFixedPoint: TClientDataSet
+    Active = True
+    Aggregates = <>
+    FieldDefs = <
+      item
+        Name = 'ID'
+        DataType = ftInteger
+      end
+      item
+        Name = 'Fixed'
+        DataType = ftBoolean
+      end
+      item
+        Name = 'FileName'
+        DataType = ftWideString
+        Size = 100
+      end
+      item
+        Name = 'FileDir'
+        DataType = ftWideString
+        Size = 200
+      end
+      item
+        Name = 'IsExists'
+        DataType = ftWideString
+        Size = 2
+      end
+      item
+        Name = 'CreateTime'
+        DataType = ftDateTime
+      end>
+    IndexDefs = <>
+    Params = <>
+    StoreDefs = True
+    BeforeDelete = cdsUnFixedPointBeforeDelete
+    Left = 400
+    Top = 39
+    Data = {
+      9C0000009619E0BD0100000018000000060000000000030000009C0002494404
+      0001000000000005466978656402000300000000000846696C654E616D650100
+      4A000000010005574944544802000200C8000746696C6544697202004A000000
+      010005574944544802000200900108497345786973747301004A000000010005
+      57494454480200020004000A43726561746554696D6508000800000000000000}
+    object cdsFixedPointID: TIntegerField
+      FieldName = 'ID'
+    end
+    object cdsFixedPointFixed: TBooleanField
+      FieldName = 'Fixed'
+    end
+    object cdsFixedPointFileName: TWideStringField
+      FieldName = 'FileName'
+      Size = 100
+    end
+    object cdsFixedPointFileDir: TWideStringField
+      FieldName = 'FileDir'
+      Size = 200
+    end
+    object cdsFixedPointIsExists: TWideStringField
+      FieldName = 'IsExists'
+      Size = 2
+    end
+    object cdsFixedPointCreateTime: TDateTimeField
+      FieldName = 'CreateTime'
+    end
+  end
+  object atHisRestorePoint: TADOTable
+    TableName = 'HisRestorePoints'
+    Left = 73
+    Top = 25
+  end
+  object dspHisRestorePoint: TDataSetProvider
+    DataSet = atHisRestorePoint
+    UpdateMode = upWhereKeyOnly
+    Left = 75
+    Top = 97
+  end
+end

+ 298 - 0
DB/HisRestorePointDM.pas

@@ -0,0 +1,298 @@
+unit HisRestorePointDM;
+
+interface
+
+uses
+  SysUtils, Classes, DB, DBClient, Windows, Provider, ADODB;
+
+type
+  TDMHisRestorePoint = class(TDataModule)
+    cdsOrgHisPoint: TClientDataSet;
+    cdsUnFixedPoint: TClientDataSet;
+    cdsFixedPoint: TClientDataSet;
+    cdsOrgHisPointID: TIntegerField;
+    cdsOrgHisPointFixed: TBooleanField;
+    cdsOrgHisPointFileName: TWideStringField;
+    cdsOrgHisPointFileDir: TWideStringField;
+    cdsUnFixedPointID: TIntegerField;
+    cdsUnFixedPointFixed: TBooleanField;
+    cdsUnFixedPointFileName: TWideStringField;
+    cdsUnFixedPointFileDir: TWideStringField;
+    cdsFixedPointID: TIntegerField;
+    cdsFixedPointFixed: TBooleanField;
+    cdsFixedPointFileName: TWideStringField;
+    cdsFixedPointFileDir: TWideStringField;
+    cdsUnFixedPointIsExists: TWideStringField;
+    cdsFixedPointIsExists: TWideStringField;
+    cdsOrgHisPointCreateTime: TDateTimeField;
+    cdsUnFixedPointCreateTime: TDateTimeField;
+    cdsFixedPointCreateTime: TDateTimeField;
+    atHisRestorePoint: TADOTable;
+    dspHisRestorePoint: TDataSetProvider;
+    procedure DataModuleCreate(Sender: TObject);
+    procedure cdsUnFixedPointBeforeDelete(DataSet: TDataSet);
+  private
+    FFileDir: string;
+    FProjectPath: string;
+    FProjectName: string;
+    function NewPointName(AID: Integer): string;
+    function GetPointID(var aNew: Boolean; aFixed: Boolean): Integer;
+    procedure DeleteCurFile(aFixed: Boolean);
+    procedure SetProjectPath(const Value: string);
+    function GetConnection: TADOConnection;
+    procedure SetConnection(const Value: TADOConnection);
+    procedure SetProjectName(const Value: string);
+    procedure Save;
+    // Added by GiLi 2012-4-23 获取当前程序路径
+    function GetApplicationPath: string;
+  public
+    procedure SavePoint(aFixed: Boolean = False);
+    procedure RefreshPoints;
+
+    function GetCurPointPath(aFixed: Boolean): string;
+    procedure DeleteCurPoint(aFixed: Boolean);
+    procedure DeleteAllPoints;
+
+    property ProjectPath: string read FProjectPath write SetProjectPath;
+    property ProjectName: string read FProjectName write SetProjectName;
+    property Connection: TADOConnection read GetConnection write SetConnection;
+  end;
+
+implementation
+
+{$R *.dfm}
+
+uses ConstVarUnit, ConstMethodUnit;
+
+{ TDMHisRestorePoint }
+
+procedure TDMHisRestorePoint.DeleteCurFile(aFixed: Boolean);
+var
+  strPath: string;
+begin
+  strPath := GetCurPointPath(aFixed);
+  if FileExists(strPath) then
+    Windows.DeleteFile(PChar(strPath));
+end;
+
+procedure TDMHisRestorePoint.DeleteCurPoint(aFixed: Boolean);
+begin
+  DeleteCurFile(aFixed);
+  if aFixed then
+    cdsFixedPoint.Delete
+  else
+    cdsUnFixedPoint.Delete;
+end;
+
+function TDMHisRestorePoint.GetCurPointPath(aFixed: Boolean): string;
+begin
+  if aFixed then
+    Result := cdsFixedPointFileDir.Value + cdsFixedPointFileName.Value
+  else
+    Result := cdsUnFixedPointFileDir.Value + cdsUnFixedPointFileName.Value;
+end;
+
+procedure TDMHisRestorePoint.RefreshPoints;
+var
+  strFileName: string;
+begin
+  cdsUnFixedPoint.EmptyDataSet;
+  cdsFixedPoint.EmptyDataSet;
+
+  cdsOrgHisPoint.First;
+  while not cdsOrgHisPoint.Eof do
+  begin
+    if cdsOrgHisPointFixed.Value then
+    begin
+      cdsFixedPoint.Append;
+      cdsFixedPointID.Value := cdsOrgHisPointID.Value;
+      cdsFixedPointFixed.Value := True;
+      cdsFixedPointFileName.Value := cdsOrgHisPointFileName.Value;
+      cdsFixedPointFileDir.Value := cdsOrgHisPointFileDir.Value;
+      cdsFixedPointCreateTime.Value := cdsOrgHisPointCreateTime.Value;
+      strFileName := cdsOrgHisPointFileDir.Value + cdsOrgHisPointFileName.Value;
+      if FileExists(strFileName) then
+        cdsFixedPointIsExists.Value := '存在'
+      else
+        cdsFixedPointIsExists.Value := '不存在';
+      cdsFixedPoint.Post;
+    end
+    else
+    begin
+      cdsUnFixedPoint.Append;
+      cdsUnFixedPointID.Value := cdsOrgHisPointID.Value;
+      cdsUnFixedPointFixed.Value := False;
+      cdsUnFixedPointCreateTime.Value := cdsOrgHisPointCreateTime.Value;      
+      cdsUnFixedPointFileName.Value := cdsOrgHisPointFileName.Value;
+      cdsUnFixedPointFileDir.Value := cdsOrgHisPointFileDir.Value;
+      strFileName := cdsOrgHisPointFileDir.Value + cdsOrgHisPointFileName.Value;
+      if FileExists(strFileName) then
+        cdsUnFixedPointIsExists.Value := '存在'
+      else
+        cdsUnFixedPointIsExists.Value := '不存在';
+      cdsUnFixedPoint.Post;
+    end;
+
+    cdsOrgHisPoint.Next;
+  end;
+end;
+
+procedure TDMHisRestorePoint.SavePoint(aFixed: Boolean);
+var
+  iID: Integer;
+  bNew: Boolean;
+  strFile: string;
+begin
+  iID := GetPointID(bNew, aFixed);
+  if bNew then
+  begin
+    cdsOrgHisPoint.Append;
+    cdsOrgHisPointID.Value := iID;
+    cdsOrgHisPointFixed.Value := aFixed;
+    cdsOrgHisPointCreateTime.Value := Now;
+    cdsOrgHisPointFileName.Value := NewPointName(iID);
+    cdsOrgHisPointFileDir.Value := FFileDir;
+    cdsOrgHisPoint.Post;
+  end
+  else
+  begin
+    if cdsOrgHisPoint.Locate(SID, iID, []) then
+    begin
+      cdsOrgHisPoint.Edit;
+      cdsOrgHisPointCreateTime.Value := Now;
+      cdsOrgHisPointFileName.Value := NewPointName(iID);
+      cdsOrgHisPointFileDir.Value := FFileDir;
+      cdsOrgHisPoint.Post;
+    end;
+  end;
+  Save;
+
+  strFile := cdsOrgHisPointFileDir.Value + cdsOrgHisPointFileName.Value;
+  if not DirectoryExists(FFileDir) then
+    ForceDirectories(FFileDir);
+  CopyFile(PChar(FProjectPath), PChar(strFile), False);
+end;
+
+procedure TDMHisRestorePoint.DataModuleCreate(Sender: TObject);
+begin
+  cdsUnFixedPoint.IndexFieldNames := sCreateTime;
+  cdsFixedPoint.IndexFieldNames := sCreateTime;
+  FFileDir := ExtractFilePath(ParamStr(0));
+end;
+
+function TDMHisRestorePoint.GetPointID(var aNew: Boolean; aFixed: Boolean): Integer;
+var
+  bFlag: Boolean;
+  iRefCount, iFirstID: Integer;
+begin
+  bFlag := False;
+  iRefCount := 0;
+  if aFixed then Result := 5 else Result := 0;
+
+  cdsOrgHisPoint.First;
+  while not cdsOrgHisPoint.Eof do
+  begin
+    if cdsOrgHisPointFixed.Value = aFixed then
+    begin
+      if not bFlag then
+      begin
+        iFirstID := cdsOrgHisPointID.Value;
+        bFlag := True;
+      end;
+      Result := cdsOrgHisPointID.Value;
+      Inc(iRefCount);
+    end;
+    cdsOrgHisPoint.Next;
+  end;
+
+  if iRefCount < MaxRPointCount then
+  begin
+    aNew := True;
+    Result := Result + 1;
+  end
+  else
+  begin
+    aNew := False;
+    Result := iFirstID;
+  end;
+end;
+
+function TDMHisRestorePoint.NewPointName(AID: Integer): string;
+var
+  strName: string;
+begin
+//  DateTimeToString(strName, 'yyyy.m.d.h.m.s', Now);
+//  strName := FormatDateTime('yyyy.m.d.h.m.s', Now);
+  Result := Format('%s.bak', [IntToStr(AID)]);
+end;
+
+procedure TDMHisRestorePoint.SetProjectPath(const Value: string);
+begin
+  FProjectPath := Value;
+//  FProjectName := ExtractFileNameWithoutExt(FProjectPath);
+//  FFileDir := Format('%s%s\%s\', [FFileDir, sBackUpFolder, FProjectName]);
+end;
+
+procedure TDMHisRestorePoint.cdsUnFixedPointBeforeDelete(
+  DataSet: TDataSet);
+begin
+  if cdsOrgHisPoint.Locate(SID, DataSet.FieldByName(SID).AsInteger, []) then
+    cdsOrgHisPoint.Delete;
+end;
+
+function TDMHisRestorePoint.GetConnection: TADOConnection;
+begin
+  Result := atHisRestorePoint.Connection;
+end;
+
+procedure TDMHisRestorePoint.SetConnection(const Value: TADOConnection);
+begin
+  atHisRestorePoint.Connection := Value;
+  if Assigned(Value) then
+  begin
+    cdsOrgHisPoint.Active := True;
+    cdsOrgHisPoint.IndexFieldNames := 'CreateTime';
+    cdsUnFixedPoint.Active := True;
+    cdsFixedPoint.Active := True;
+  end;
+end;
+
+procedure TDMHisRestorePoint.Save;
+begin
+  cdsOrgHisPoint.ApplyUpdates(0);
+end;
+
+procedure TDMHisRestorePoint.SetProjectName(const Value: string);
+begin
+  FProjectName := Value;
+  FFileDir := Format('%s%s\%s\', [GetApplicationPath, sBackUpFolder, FProjectName]);
+end;
+
+function TDMHisRestorePoint.GetApplicationPath: string;
+begin
+  Result := ExtractFilePath(ParamStr(0));
+end;
+
+procedure TDMHisRestorePoint.DeleteAllPoints;
+begin
+  if not Assigned(cdsOrgHisPoint) then
+    Exit;
+  if not cdsOrgHisPoint.Active then
+    Exit;
+
+  cdsUnFixedPoint.First;
+  while not cdsUnFixedPoint.Eof do
+  begin
+    DeleteCurPoint(False);
+    cdsUnFixedPoint.First;
+  end;
+  cdsFixedPoint.First;
+  while not cdsFixedPoint.Eof do
+  begin
+    DeleteCurPoint(True);
+    cdsUnFixedPoint.First;
+  end;
+  cdsOrgHisPoint.ApplyUpdates(0);
+end;
+
+end.

+ 45 - 0
DB/LocateBillsDM.dfm

@@ -0,0 +1,45 @@
+object BillsLocateDM: TBillsLocateDM
+  OldCreateOrder = False
+  Left = 456
+  Top = 238
+  Height = 170
+  Width = 261
+  object cdsQBItems: TClientDataSet
+    Active = True
+    Aggregates = <>
+    Params = <>
+    OnFilterRecord = cdsQBItemsFilterRecord
+    Left = 96
+    Top = 56
+    Data = {
+      A70000009619E0BD010000001800000007000000000003000000A70004436F64
+      6501004A0000000100055749445448020002006400044E616D6501004A000000
+      010005574944544802000200640005556E69747301004A000000010005574944
+      5448020002002800085175616E74697479080004000000000009556E69745072
+      69636508000400000000000A546F74616C507269636508000400000000000249
+      4404000100000000000000}
+    object cdsQBItemsCode: TWideStringField
+      FieldName = 'Code'
+      Size = 50
+    end
+    object cdsQBItemsName: TWideStringField
+      FieldName = 'Name'
+      Size = 50
+    end
+    object cdsQBItemsUnits: TWideStringField
+      FieldName = 'Units'
+    end
+    object cdsQBItemsQuantity: TFloatField
+      FieldName = 'Quantity'
+    end
+    object cdsQBItemsUnitPrice: TFloatField
+      FieldName = 'UnitPrice'
+    end
+    object cdsQBItemsTotalPrice: TFloatField
+      FieldName = 'TotalPrice'
+    end
+    object cdsQBItemsID: TIntegerField
+      FieldName = 'ID'
+    end
+  end
+end

+ 198 - 0
DB/LocateBillsDM.pas

@@ -0,0 +1,198 @@
+unit LocateBillsDM;
+
+interface
+
+uses
+  SysUtils,
+  Classes,
+  DB,
+  ScBillsTree,
+  DataBase,
+  ScProjectManager,
+  DBClient;
+
+type
+  TBillsLocateDM = class(TDataModule)
+    cdsQBItems: TClientDataSet;
+    cdsQBItemsCode: TWideStringField;
+    cdsQBItemsName: TWideStringField;
+    cdsQBItemsUnits: TWideStringField;
+    cdsQBItemsQuantity: TFloatField;
+    cdsQBItemsUnitPrice: TFloatField;
+    cdsQBItemsTotalPrice: TFloatField;
+    cdsQBItemsID: TIntegerField;
+    procedure cdsQBItemsFilterRecord(DataSet: TDataSet;
+      var Accept: Boolean);
+  private
+    { Private declarations }
+    FBillsData: TDMDataBase;
+    FCount: Integer;
+    FStrings: TStrings;
+    FCode: string;
+    FProjectMgr: TProjectManager;
+    procedure SetBillsData(const Value: TDMDataBase);
+    procedure DrawBills; overload;
+    procedure DrawBills(aNode: TScBillsItem; var aFilter: string); overload;
+  public
+    { Public declarations }
+    constructor Create(AProjMgr: TProjectManager);
+    destructor Destroy; override;
+
+    procedure FindFirstBills(const aCode: string);
+    procedure NextBills;
+    procedure LocateBills;
+    procedure RefreshBills;
+    property BillsData: TDMDataBase read FBillsData write SetBillsData;
+  end;
+
+implementation
+
+uses ZjIDTree;
+
+{$R *.dfm}
+
+{ TBillsLocateDM }
+
+constructor TBillsLocateDM.Create(AProjMgr: TProjectManager);
+begin
+  inherited Create(nil);
+  FProjectMgr := AProjMgr;
+  FStrings := TStringList.Create;
+end;
+
+procedure TBillsLocateDM.DrawBills;
+var
+  I: Integer;
+  sFilter: string;
+begin
+  cdsQBItems.DisableControls;
+  try
+    cdsQBItems.EmptyDataSet;
+    with FBillsData do
+    begin
+     { FCount := 0;
+      FStrings.Clear;
+      DrawBills(TScBillsItem(BillsTree.FirstNode), sFilter);
+      if sFilter <> '' then FStrings.Add(sFilter);
+      for I := 0 to FStrings.Count - 1 do
+      begin
+        sFilter := FStrings[I];    }
+        cdsBills.Filter := 'B_Code<>'''''; //sFilter;
+        cdsBills.Filtered := True;
+        try
+          cdsBills.First;
+          while not cdsBills.Eof do
+          begin
+            cdsQBItems.Append;
+            cdsQBItemsID.Value := cdsBillsID.Value;
+            cdsQBItemsCode.Value := cdsBillsB_Code.Value;
+            cdsQBItemsName.Value := cdsBillsName.Value;
+            cdsQBItemsUnits.Value := cdsBillsUnits.Value;
+            cdsQBItemsQuantity.Value := cdsBillsQuantity.Value;
+            cdsQBItemsUnitPrice.Value := cdsBillsUnitPrice.Value;
+            cdsQBItemsTotalPrice.Value := cdsBillsTotalPrice.Value;
+            cdsQBItems.Post;
+
+            cdsBills.Next;
+          end;
+        finally
+          cdsBills.Filtered := False;
+        end;
+//      end;
+    end;
+  finally
+    cdsQBItems.First;
+    cdsQBItems.EnableControls;
+  end;
+end;
+
+destructor TBillsLocateDM.Destroy;
+begin
+  FStrings.Free;
+  inherited;
+end;
+
+procedure TBillsLocateDM.DrawBills(aNode: TScBillsItem; var aFilter: string);
+var
+  I: Integer;
+  sbiNode: TScBillsItem;
+begin
+  if not Assigned(aNode) then Exit;
+  
+  if aNode.SBillBCode <> '' then
+  begin
+    if aFilter <> '' then
+    begin
+      aFilter := aFilter + ' or ID=' + IntToStr(aNode.ID);
+    end
+    else
+    begin
+      aFilter := 'ID=' + IntToStr(aNode.ID);
+    end;
+
+    Inc(FCount);
+    if FCount = 500 then
+    begin
+      FStrings.Add(aFilter);
+      FCount := 0;
+      aFilter := '';
+    end;
+  end;
+
+  for I := 0 to aNode.ChildCount - 1 do
+  begin
+    sbiNode := TScBillsItem(aNode.ChildNodes[I]);
+    DrawBills(sbiNode, aFilter);
+  end;
+end;
+
+procedure TBillsLocateDM.NextBills;
+var
+  sCode: string;
+begin
+  sCode := cdsQBItemsCode.AsString;
+  cdsQBItems.Next;
+{  while not cdsQBItems.Eof do
+  begin
+    if cdsQBItemsCode.Value = sCode then
+      Break;
+    cdsQBItems.Next;
+  end;        }
+end;
+
+procedure TBillsLocateDM.SetBillsData(const Value: TDMDataBase);
+begin
+  FBillsData := Value;
+  if Assigned(FBillsData) then
+    DrawBills;
+end;
+
+procedure TBillsLocateDM.LocateBills;
+begin
+  FBillsData.cdsOrgBills.FindKey([cdsQBItemsID.AsInteger]);
+end;
+
+procedure TBillsLocateDM.RefreshBills;
+begin
+  cdsQBItems.Filtered := False;
+  BillsData := FProjectMgr.ActiveProject.BillsData;
+end;
+
+procedure TBillsLocateDM.FindFirstBills(const aCode: string);
+begin
+  FCode := aCode;
+  cdsQBItems.Filtered := False;
+  if FCode <> '' then
+    cdsQBItems.Filtered := True;
+end;
+
+procedure TBillsLocateDM.cdsQBItemsFilterRecord(DataSet: TDataSet;
+  var Accept: Boolean);
+begin
+  if Pos(FCode, cdsQBItemsCode.AsString) <> 0 then
+    Accept := True
+  else
+    Accept := False;
+end;
+
+end.

+ 57 - 0
DB/ProjectManagerDM.dfm

@@ -0,0 +1,57 @@
+object ProjectMgrDM: TProjectMgrDM
+  OldCreateOrder = False
+  Left = 499
+  Top = 279
+  Height = 344
+  Width = 362
+  object ADOConnection: TADOConnection
+    LoginPrompt = False
+    Mode = cmReadWrite
+    Provider = 'Microsoft.Jet.OLEDB.4.0'
+    Left = 56
+    Top = 32
+  end
+  object aqBidLotProject: TADOQuery
+    AfterScroll = aqBidLotProjectAfterScroll
+    Parameters = <>
+    Left = 160
+    Top = 128
+  end
+  object atGatherProject: TADOTable
+    AfterScroll = atGatherProjectAfterScroll
+    TableName = 'ProjectManager'
+    Left = 56
+    Top = 128
+    object atGatherProjectID: TIntegerField
+      FieldName = 'ID'
+    end
+    object atGatherProjectProjectName: TWideStringField
+      FieldName = 'ProjectName'
+      Size = 100
+    end
+    object atGatherProjectUnKnowName: TWideStringField
+      FieldName = 'UnKnowName'
+      Size = 50
+    end
+    object atGatherProjectFullName: TWideStringField
+      FieldName = 'FullName'
+      Size = 100
+    end
+    object atGatherProjectGatherID: TIntegerField
+      FieldName = 'GatherID'
+    end
+    object atGatherProjectFlag: TIntegerField
+      FieldName = 'Flag'
+    end
+  end
+  object aqCheckData: TADOQuery
+    Parameters = <>
+    Left = 160
+    Top = 224
+  end
+  object aqGatherBid: TADOQuery
+    Parameters = <>
+    Left = 256
+    Top = 128
+  end
+end

+ 661 - 0
DB/ProjectManagerDM.pas

@@ -0,0 +1,661 @@
+unit ProjectManagerDM;
+
+interface
+
+uses
+  SysUtils,
+  Classes,
+  ADODB,
+  DB,
+  ConstVarUnit,
+  DBClient,
+  Windows,
+  Provider;
+
+type
+  TProjectMgrDM = class(TDataModule)
+    ADOConnection: TADOConnection;
+    aqBidLotProject: TADOQuery;
+    atGatherProject: TADOTable;
+    atGatherProjectID: TIntegerField;
+    atGatherProjectProjectName: TWideStringField;
+    atGatherProjectUnKnowName: TWideStringField;
+    atGatherProjectFullName: TWideStringField;
+    atGatherProjectGatherID: TIntegerField;
+    atGatherProjectFlag: TIntegerField;
+    aqCheckData: TADOQuery;
+    aqGatherBid: TADOQuery;
+    procedure atGatherProjectAfterScroll(DataSet: TDataSet);
+    procedure aqBidLotProjectAfterScroll(DataSet: TDataSet);
+  private
+    { Do SQL }
+    procedure OpenSQL(aQuery: TADOQuery; const aSql: string);
+    procedure ExecuteSQL(aQuery: TADOQuery; const aSql: string);
+
+    function HasRecords(aProjKind: Integer): Boolean;
+    procedure RefreshData;
+    procedure DeleteProject(aProjID: Integer; aStrings: TStrings);
+    procedure InnerDeleteProject(aProjKind: Integer);
+    procedure RefreshGatherBid(aProjID, aBidLotID: Integer); overload;
+    function GetMaxProjectID: Integer;
+    procedure InsertProject(aID, aGatherID, aFlag: Integer; const aProjName, aUnKnowName, aFullName: string);
+  public
+    procedure RefreshBidLot(aProjID: Integer; ALocateLast: Boolean = False);
+    procedure RefreshGatherBid(aIsImport: Boolean = False); overload;
+    procedure RefreshBuildProject;
+    
+    procedure OpenDataBase(const aDataBase: string);
+    { locate record }
+    procedure LocateBuildProject(aID: Integer);
+    { get Name }
+    function GetProjectName(aProjKind: Integer): string;
+    function GetFileName(aProjKind: Integer): string;
+    function GetProjectID(aProjKind: Integer): Integer;
+    { get name by id }
+    function GetParentID(aID: Integer): Integer;
+    procedure GetNameByID(aID: Integer; var aProjName, aFullName: string);
+    procedure GetBidLotsByID(aID: Integer; aStrings: TStrings);
+    { get values by aprojID }
+    procedure GetValues(var aProjID, aGatherID, aFlag: Integer; var aProjName, aFullPath: string);
+    procedure GetBidLots(aProjID: Integer; aProjList: TList);
+    procedure GetBuildProjectList(aString: TStrings);
+    function GetBuildProjRecordNo: Integer;
+    function GetProjectFlag(aID: Integer): Integer;
+    { Check }
+    function CanOpen(aProjKind: Integer): Boolean;
+    procedure CheckSameProjectName(aProjKind: Integer; var aNewProjName: string; aRaise: Boolean = True);
+    function ChackSameProjectForOneKey(aGatherID: Integer; var aNewProjName: string; var IsExist: Boolean): Boolean;
+    procedure CheckSameProject(aGatherID: Integer; var aNewProjName: string; aRaise: Boolean = True);
+    function CheckUnknowNameExists(const aUnknowName: string): Boolean;
+    { project }
+    procedure DeleteProjects(aProjKind: Integer; aStrings: TStrings);
+    function AddProject(const aProjName, aUnknowName, aFullName: string; aProjKind: Integer): Integer; overload;
+    function AddProject(const aProjName, aUnknowName, aFullName: string; aGatherID, aFlag: Integer): Integer; overload;
+    { rename }
+    procedure RenameProject(aProjKind: Integer; const aNewProjectName: string);
+  end;
+
+implementation
+
+uses
+  DateUtils,
+  ScUtils,
+  ProjectFileManager,
+  MainForm,
+  Variants;
+
+{$R *.dfm}
+
+{ TProjectMgrDM }
+
+procedure TProjectMgrDM.RefreshBidLot(aProjID: Integer; ALocateLast: Boolean);
+var
+  sSql: string;
+begin
+  sSql := Format('Select * From ProjectManager Where (GatherID = %d) and (Flag = 2)', [aProjID]);
+  OpenSQL(aqBidLotProject, sSql);
+
+  if ALocateLast then
+    aqBidLotProject.Last;
+
+  RefreshGatherBid;
+end;
+
+procedure TProjectMgrDM.atGatherProjectAfterScroll(DataSet: TDataSet);
+begin
+  if DataSet.RecordCount > 0 then
+    RefreshBidLot(DataSet['ID'])
+  else
+    RefreshBidLot(0);
+end;
+
+function TProjectMgrDM.GetFileName(aProjKind: Integer): string;
+begin
+  if aProjKind = 1 then
+  begin
+    if VarIsNull(atGatherProject['FullName']) then
+    begin
+      Result := '';
+      Exit;
+    end;
+    Result := atGatherProject['FullName']
+  end
+  else if aProjKind = 2 then
+  begin
+    if VarIsNull(aqBidLotProject['FullName']) then
+    begin
+      Result := '';
+      Exit;
+    end;
+    Result := aqBidLotProject['FullName'];
+  end
+  else
+  begin
+    if VarIsNull(aqGatherBid['FullName']) then
+    begin
+      Result := '';
+      Exit;
+    end;
+    Result := aqGatherBid['FullName'];
+  end;
+end;
+
+procedure TProjectMgrDM.DeleteProject(aProjID: Integer; aStrings: TStrings);
+var
+  sSql: string;
+  adoQuery: TADOQuery;
+begin
+  adoQuery := TADOQuery.Create(nil);
+  try
+    with adoQuery do
+    begin
+      Connection := ADOConnection;
+
+      sSql := Format('Select * From ProjectManager Where GatherID = %d', [aProjID]);
+      OpenSQL(adoQuery, sSql);
+
+      First;
+      while not Eof do
+      begin
+        aStrings.Add(FieldByName('FullName').AsString);
+        DeleteProject(FieldByName('ID').AsInteger, aStrings);
+        Delete;
+      end;
+    end;
+  finally
+    adoQuery.Free;
+  end;
+end;
+
+function TProjectMgrDM.CheckUnknowNameExists(const aUnknowName: string): Boolean;
+var
+  sSql: string;
+begin
+  sSql := Format('Select * From ProjectManager where UnKnowName = ''%s''', [aUnknowName]);
+  OpenSQL(aqCheckData, sSql);
+
+  Result := aqCheckData.RecordCount <> 0;
+end;
+
+function TProjectMgrDM.AddProject(const aProjName, aUnknowName,
+  aFullName: string; aProjKind: Integer): Integer;
+var
+  BookMark: TBookmark;
+  iGatherID: Integer;
+begin
+  Result := GetMaxProjectID;
+
+  if aProjKind = 1 then
+    atGatherProject.AppendRecord([Result, aProjName, aUnknowName, aFullName, 0, 1])
+  else if aProjKind = 2 then
+  begin
+    iGatherID := atGatherProjectID.AsInteger;
+    InsertProject(Result, iGatherID, 2, aProjName, aUnknowName, aFullName);
+//    atGatherProject.AppendRecord([iMaxID, aProjName, aUnknowName, aFullName, iGatherID, 2]);
+  end
+  else
+  begin
+    iGatherID := aqBidLotProject['ID'];
+    InsertProject(Result, iGatherID, 3, aProjName, aUnknowName, aFullName);
+//    atGatherProject.AppendRecord([iMaxID, aProjName, aUnknowName, aFullName, iGatherID, 3]);
+  end;
+end;
+
+procedure TProjectMgrDM.OpenDataBase(const aDataBase: string);
+begin
+  ADOConnection.Connected := False;
+  ADOConnection.ConnectionString := Format(SAdoConnectStr, [aDataBase, 'Admin', '']);
+  ADOConnection.Connected := True;
+  RefreshData;
+end;
+
+procedure TProjectMgrDM.RefreshData;
+begin
+  atGatherProject.Connection := ADOConnection;
+  aqBidLotProject.Connection := ADOConnection;
+  aqCheckData.Connection := ADOConnection;
+  aqGatherBid.Connection := ADOConnection;
+
+  atGatherProject.Open;
+  with atGatherProject do
+  begin
+    Filter := 'Flag=1';
+    Filtered := True;
+  end;
+end;
+
+function TProjectMgrDM.GetProjectName(aProjKind: Integer): string;
+begin
+  Result := '';
+  if aProjKind = 1 then
+    Result := atGatherProject['ProjectName']
+  else if aProjKind = 2 then
+  begin
+    if aqBidLotProject.RecordCount > 0 then
+      Result := aqBidLotProject['ProjectName'];
+  end
+  else
+    if aqGatherBid.RecordCount > 0 then
+      Result := aqGatherBid['ProjectName'];
+end;
+
+procedure TProjectMgrDM.RenameProject(aProjKind: Integer; const aNewProjectName: string);
+begin
+  if aProjKind = 1 then
+  begin
+    atGatherProject.Edit;
+    atGatherProjectProjectName.Value := aNewProjectName;
+    atGatherProject.Post;
+  end
+  else if aProjKind = 2 then
+  begin
+    aqBidLotProject.Edit;
+    aqBidLotProject['ProjectName'] := aNewProjectName;
+    aqBidLotProject.Post;
+  end
+  else
+  begin
+    aqGatherBid.Edit;
+    aqGatherBid['ProjectName'] := aNewProjectName;
+    aqGatherBid.Post;
+  end;
+end;
+
+function TProjectMgrDM.CanOpen(aProjKind: Integer): Boolean;
+begin
+  Result := True;
+  {if aProjKind = 1 then
+    Result := atGatherProjectID.Value <> 1;    }
+end;
+
+procedure TProjectMgrDM.RefreshGatherBid(aProjID, aBidLotID: Integer);
+var
+  sSql: string;
+begin
+  sSql := Format('Select * From ProjectManager Where ' +
+                 '((GatherID = %d) or (GatherID = %d)) and (Flag = 3)',
+                 [aProjID, aBidLotID]);
+                 
+  OpenSQL(aqGatherBid, sSql);
+end;
+
+function TProjectMgrDM.GetProjectID(aProjKind: Integer): Integer;
+begin
+  if aProjKind = 1 then
+    Result := atGatherProject['ID']
+  else if aProjKind = 2 then
+  begin
+    if aqBidLotProject.RecordCount > 0 then
+      Result := aqBidLotProject['ID']
+    else
+      Result := -1;
+  end
+  else
+  begin
+    if aqGatherBid.RecordCount > 0 then
+      Result := aqGatherBid['ID']
+    else
+      Result :=  -1;
+  end;
+end;
+
+procedure TProjectMgrDM.GetValues(var aProjID, aGatherID, aFlag: Integer;
+  var aProjName, aFullPath: string);
+var
+  sSql: string;
+begin
+  sSql := Format('Select * From ProjectManager Where ID = %d', [aProjID]);
+  OpenSQL(aqCheckData, sSql);
+
+  with aqCheckData do
+  begin
+    if RecordCount > 0 then
+    begin
+      aGatherID := FieldByName('GatherID').AsInteger;
+      aFlag := FieldByName('Flag').AsInteger;
+      aProjName := FieldByName('ProjectName').AsString;
+      aFullPath := FieldByName('FullName').AsString;
+    end
+    else
+    begin
+      aProjID := -1;
+    end;
+  end;
+end;
+
+procedure TProjectMgrDM.GetBidLots(aProjID: Integer; aProjList: TList);
+var
+  sSql: string;
+begin
+  sSql := Format('Select * From ProjectManager Where GatherID = %d', [aProjID]);
+  OpenSQL(aqCheckData, sSql);
+  
+  with aqCheckData do
+  begin
+    First;
+    while not Eof do
+    begin
+      aProjList.Add(Pointer(FieldByName('ID').AsInteger));
+      Next;
+    end;
+  end;
+end;
+
+function TProjectMgrDM.AddProject(const aProjName, aUnknowName,
+  aFullName: string; aGatherID, aFlag: Integer): Integer;
+begin
+  Result := GetMaxProjectID;
+  InsertProject(Result, aGatherID, aFlag, aProjName, aUnknowName, aFullName);
+
+//  atGatherProject.AppendRecord([iMaxID, aProjName, aUnknowName, aFullName, aGatherID, aFlag])
+end;
+
+procedure TProjectMgrDM.aqBidLotProjectAfterScroll(DataSet: TDataSet);
+begin
+  if DataSet.RecordCount > 0 then
+    RefreshGatherBid(atGatherProjectID.AsInteger, DataSet['ID']);
+end;
+
+procedure TProjectMgrDM.RefreshGatherBid(aIsImport: Boolean);
+begin
+  if aqBidLotProject.RecordCount > 0 then
+    RefreshGatherBid(atGatherProjectID.AsInteger, aqBidLotProject['ID'])
+  else
+    RefreshGatherBid(atGatherProjectID.AsInteger, -2);
+
+  if aIsImport then aqGatherBid.Last;
+end;
+
+function TProjectMgrDM.HasRecords(aProjKind: Integer): Boolean;
+begin
+  if aProjKind = 1 then
+    Result := atGatherProject.RecordCount > 0
+  else if aProjKind = 2 then
+    Result := aqBidLotProject.RecordCount > 0
+  else
+    Result := aqGatherBid.RecordCount > 0;
+end;
+
+procedure TProjectMgrDM.GetBuildProjectList(aString: TStrings);
+begin
+  OpenSQL(aqCheckData, 'Select * From ProjectManager where Flag = 1');
+
+  with aqCheckData do
+  begin
+    First;
+    while not Eof do
+    begin
+      aString.AddObject(FieldByName('ProjectName').AsString,
+                        Pointer(FieldByName('ID').AsInteger));
+      Next;
+    end;
+  end;
+end;
+
+procedure TProjectMgrDM.LocateBuildProject(aID: Integer);
+begin
+  if atGatherProjectID.AsInteger <> aID then
+    atGatherProject.Locate('ID', aID, []);
+end;
+
+procedure TProjectMgrDM.DeleteProjects(aProjKind: Integer; aStrings: TStrings);
+var
+  iID: Integer;
+  sSql: string;
+begin
+  with aqCheckData do
+  begin
+    iID := GetProjectID(aProjKind);
+    aStrings.Add(GetFileName(aProjKind));
+
+    InnerDeleteProject(aProjKind);
+
+    sSql := Format('Select * From ProjectManager Where GatherID = %d', [iID]);
+    OpenSQL(aqCheckData, sSql);
+
+    First;
+    while not Eof do
+    begin
+      aStrings.Add(FieldByName('FullName').AsString);
+      DeleteProject(FieldByName('ID').AsInteger, aStrings);
+      Delete;
+    end;
+  end;
+end;
+
+procedure TProjectMgrDM.InnerDeleteProject(aProjKind: Integer);
+begin
+  case aProjKind of
+    1: atGatherProject.Delete;
+    2: aqBidLotProject.Delete;
+    else aqGatherBid.Delete;
+  end;
+end;
+
+function TProjectMgrDM.GetBuildProjRecordNo: Integer;
+begin
+  Result := atGatherProject.RecNo;
+end;
+
+function TProjectMgrDM.GetProjectFlag(aID: Integer): Integer;
+var
+  sSql: string;
+begin
+  sSql := Format('Select * From ProjectManager Where ID = %d', [aID]);
+  OpenSQL(aqCheckData, sSql);
+
+  Result := aqCheckData.FieldByName('Flag').AsInteger;
+end;
+
+procedure TProjectMgrDM.CheckSameProjectName(aProjKind: Integer; var aNewProjName: string; aRaise: Boolean);
+var
+  sSql: string;
+  iGatherID1, iGatherID2: Integer;
+begin
+  if aProjKind = 1 then
+  begin
+    iGatherID1 := 0;
+    iGatherID2 := -1;
+  end
+  else
+  begin
+    if aProjKind = 2 then
+    begin
+      iGatherID1 := atGatherProjectID.AsInteger;
+      iGatherID2 := iGatherID1;
+    end
+    else
+    begin
+      iGatherID1 := atGatherProjectID.AsInteger;
+      if aqBidLotProject.RecordCount > 0 then
+        iGatherID2 := aqBidLotProject['ID']
+      else
+        iGatherID2 := iGatherID1;
+    end;
+  end;
+
+  sSql := Format('Select * From ProjectManager where ' +
+                 '(ProjectName = ''%s'') and ((GatherID = %d) or (GatherID = %d))',
+                 [aNewProjName, iGatherID1, iGatherID2]);
+
+  OpenSQL(aqCheckData, sSql);
+
+  if aqCheckData.RecordCount <> 0 then
+  begin
+    if aRaise then raise Exception.Create('已存在同名项目!')
+    else
+    begin
+      aNewProjName := aNewProjName + '(复件)';
+      CheckSameProjectName(aProjKind, aNewProjName, False);
+    end;
+  end;
+end;
+
+procedure TProjectMgrDM.CheckSameProject(aGatherID: Integer;
+  var aNewProjName: string; aRaise: Boolean);
+var
+  sSql: string;
+begin
+  sSql := Format('Select * From ProjectManager where ' +
+                 '(ProjectName = ''%s'') and (GatherID = %d)',
+                 [aNewProjName, aGatherID]);
+
+  OpenSQL(aqCheckData, sSql);
+
+  if aqCheckData.RecordCount <> 0 then
+  begin
+    if aRaise then raise Exception.Create('已存在同名项目!')
+    else
+    begin
+      aNewProjName := aNewProjName + '(复件)';
+      CheckSameProject(aGatherID, aNewProjName, False);
+    end;
+  end;
+end;
+
+procedure TProjectMgrDM.GetBidLotsByID(aID: Integer; aStrings: TStrings);
+var
+  sFullName: string;
+  sSql: string;
+begin
+  sSql := Format('Select * From ProjectManager where GatherID = %d', [aID]);
+  OpenSQL(aqCheckData, sSql);
+
+  aStrings.Clear;
+  with aqCheckData do
+  begin
+    First;
+    while not Eof do
+    begin
+      sFullName := FieldByName('FullName').AsString;
+      aStrings.AddObject(FieldByName('ProjectName').AsString, Pointer(sFullName));
+      Integer(sFullName) := 0;
+      Next;
+    end;
+  end;
+end;
+
+procedure TProjectMgrDM.GetNameByID(aID: Integer; var aProjName,
+  aFullName: string);
+var
+  sSql: string;
+begin
+  sSql := Format('Select * From ProjectManager where ID = %d', [aID]);
+  OpenSQL(aqCheckData, sSql);
+
+  with aqCheckData do
+  begin
+    if RecordCount > 0 then
+    begin
+      aProjName := FieldByName('ProjectName').AsString;
+      aFullName := FieldByName('FullName').AsString;
+    end
+    else
+    begin
+      aProjName := '';
+      aFullName := '';
+    end;
+  end;
+end;
+
+function TProjectMgrDM.GetMaxProjectID: Integer;
+begin
+  OpenSQL(aqCheckData, 'Select Max(ID) as ID From ProjectManager');
+  Result := aqCheckData.FieldByName('ID').AsInteger + 1;
+end;
+
+procedure TProjectMgrDM.InsertProject(aID, aGatherID, aFlag: Integer;
+  const aProjName, aUnKnowName, aFullName: string);
+var
+  sSql: string;
+begin
+  sSql := Format('Insert Into ProjectManager (ID, ProjectName, UnKnowName, FullName, GatherID, Flag) ' +
+                 'Values (%d, ''%s'', ''%s'', ''%s'', %d, %d)',
+                 [aID, aProjName, aUnKnowName, aFullName, aGatherID, aFlag]);
+
+  ExecuteSQL(aqCheckData, sSql);
+end;
+
+procedure TProjectMgrDM.ExecuteSQL(aQuery: TADOQuery;
+  const aSql: string);
+begin
+  with aQuery do
+  begin
+    SQL.Clear;
+    SQL.Add(aSql);
+    ExecSQL;
+  end;
+end;
+
+procedure TProjectMgrDM.OpenSQL(aQuery: TADOQuery;
+  const aSql: string);
+begin
+  with aQuery do
+  begin
+    SQL.Clear;
+    SQL.Add(aSql);
+    Open;
+  end;
+end;
+
+function TProjectMgrDM.GetParentID(aID: Integer): Integer;
+var
+  sSql: string;
+begin
+  sSql := Format('Select * From ProjectManager Where ID = %d', [aID]);
+  OpenSQL(aqCheckData, sSql);
+
+  Result := aqCheckData.FieldByName('GatherID').AsInteger;
+end;
+
+procedure TProjectMgrDM.RefreshBuildProject;
+begin
+  with atGatherProject do
+  begin
+    Active := False;
+    Active := True;
+    Filter := 'Flag=1';
+    Filtered := True;
+    Last;
+  end;
+end;
+
+function TProjectMgrDM.ChackSameProjectForOneKey(aGatherID: Integer;
+  var aNewProjName: string; var IsExist: Boolean): Boolean;
+var
+  sSql: string;
+  iID: Integer;
+  I, iIdx: Integer;
+  strFilePath: string;
+begin
+  try
+    IsExist := False;
+    Result := True;
+    sSql := Format('Select * From ProjectManager where ' +
+                   '(ProjectName = ''%s'') and (GatherID = %d)',
+                   [aNewProjName, aGatherID]);
+
+    OpenSQL(aqCheckData, sSql);
+
+    if aqCheckData.RecordCount <> 0 then
+    begin
+      if MessageQuest(0, '该名称的项目清单文件已存在,是否覆盖?', '询问', MB_YESNO) = ID_YES then
+      begin
+        IsExist := True;
+        // 将数据删除 这里还要修改,参照Delete方法
+        strFilePath := aqCheckData.FieldByName('FullName').AsString;
+        strFilePath := MainFrm.ProjectFileManager.FileOpr.ExtractFilePath(ParamStr(0)) + strFilePath;
+        iIdx := MainFrm.ProjectFileManager.ProjectManager.CheckProjectExists(strFilePath);
+        if iIdx <> -1 then
+          MainFrm.ProjectFileManager.CloseProjectProc(MainFrm.ProjectFileManager.ProjectManager.Projects[iIdx]);
+        MainFrm.ProjectFileManager.FileOpr.DeleteFile(strFilePath);
+        aqCheckData.delete;
+      end
+      else
+        Result := False;
+    end;
+  finally
+  end;
+end;
+
+end.

+ 145 - 0
DB/ProjectPropertyDM.dfm

@@ -0,0 +1,145 @@
+object ProjPropertyDM: TProjPropertyDM
+  OldCreateOrder = False
+  Left = 410
+  Top = 315
+  Height = 270
+  Width = 293
+  object atProjProperty: TADOTable
+    TableName = 'ProjProperty'
+    Left = 40
+    Top = 20
+  end
+  object dspProjProperty: TDataSetProvider
+    DataSet = atProjProperty
+    UpdateMode = upWhereKeyOnly
+    Left = 41
+    Top = 94
+  end
+  object cdsProjProperty: TClientDataSet
+    Aggregates = <>
+    Params = <>
+    ProviderName = 'dspProjProperty'
+    Left = 44
+    Top = 165
+    object cdsProjPropertyID: TIntegerField
+      FieldName = 'ID'
+    end
+    object cdsProjPropertyName: TWideStringField
+      FieldName = 'Name'
+      Size = 128
+    end
+    object cdsProjPropertyItemValue: TWideStringField
+      FieldName = 'ItemValue'
+      Size = 50
+    end
+  end
+  object atProjData: TADOTable
+    TableName = 'ProjData'
+    Left = 180
+    Top = 19
+  end
+  object dspProjData: TDataSetProvider
+    DataSet = atProjData
+    Left = 180
+    Top = 96
+  end
+  object cdsProjData: TClientDataSet
+    Aggregates = <>
+    Params = <>
+    ProviderName = 'dspProjData'
+    Left = 179
+    Top = 168
+    object cdsProjDataBuildProjectID: TIntegerField
+      FieldName = 'BuildProjectID'
+    end
+    object cdsProjDataBuildProjectName: TWideStringField
+      FieldName = 'BuildProjectName'
+      Size = 50
+    end
+    object cdsProjDataProjectLocation: TWideStringField
+      FieldName = 'ProjectLocation'
+      Size = 50
+    end
+    object cdsProjDataBuildUnit: TWideStringField
+      FieldName = 'BuildUnit'
+      Size = 50
+    end
+    object cdsProjDataAuthorUnit: TWideStringField
+      FieldName = 'AuthorUnit'
+      Size = 50
+    end
+    object cdsProjDataBidder: TWideStringField
+      FieldName = 'Bidder'
+      Size = 50
+    end
+    object cdsProjDataAuthor: TWideStringField
+      FieldName = 'Author'
+      Size = 50
+    end
+    object cdsProjDataAuthorCertificate: TWideStringField
+      FieldName = 'AuthorCertificate'
+      Size = 50
+    end
+    object cdsProjDataAuditor: TWideStringField
+      FieldName = 'Auditor'
+      Size = 50
+    end
+    object cdsProjDataAuditorCertificate: TWideStringField
+      FieldName = 'AuditorCertificate'
+      Size = 50
+    end
+    object cdsProjDataBudgetProjectName: TWideStringField
+      FieldName = 'BudgetProjectName'
+      Size = 50
+    end
+    object cdsProjDataEditRange: TWideStringField
+      FieldName = 'EditRange'
+      Size = 50
+    end
+    object cdsProjDataEditDate: TDateTimeField
+      FieldName = 'EditDate'
+    end
+    object cdsProjDataMachineBBFeeRate: TFloatField
+      FieldName = 'MachineBBFeeRate'
+    end
+    object cdsProjDataFZFeeRate: TFloatField
+      FieldName = 'FZFeeRate'
+    end
+    object cdsProjDataIsCalcGYFeeRate: TBooleanField
+      FieldName = 'IsCalcGYFeeRate'
+    end
+    object cdsProjDataRoadLength: TFloatField
+      FieldName = 'RoadLength'
+    end
+    object cdsProjDataAvgMaintMonth: TFloatField
+      FieldName = 'AvgMaintMonth'
+    end
+    object cdsProjDataRoadClass: TIntegerField
+      FieldName = 'RoadClass'
+    end
+    object cdsProjDataIsNew: TBooleanField
+      FieldName = 'IsNew'
+    end
+    object cdsProjDataLandForm: TIntegerField
+      FieldName = 'LandForm'
+    end
+    object cdsProjDataDJZG: TFloatField
+      FieldName = 'DJZG'
+    end
+    object cdsProjDataYJZG: TFloatField
+      FieldName = 'YJZG'
+    end
+    object cdsProjDataNightZG: TFloatField
+      FieldName = 'NightZG'
+    end
+    object cdsProjDataRaiseRateByYear: TFloatField
+      FieldName = 'RaiseRateByYear'
+    end
+    object cdsProjDataRaiseYear: TFloatField
+      FieldName = 'RaiseYear'
+    end
+    object cdsProjDataBuildManageFeeFile: TIntegerField
+      FieldName = 'BuildManageFeeFile'
+    end
+  end
+end

+ 157 - 0
DB/ProjectPropertyDM.pas

@@ -0,0 +1,157 @@
+unit ProjectPropertyDM;
+
+interface
+
+uses
+  SysUtils, Classes, DBClient, Provider, DB, ADODB;
+
+type
+  TProjPropertyDM = class(TDataModule)
+    atProjProperty: TADOTable;
+    dspProjProperty: TDataSetProvider;
+    cdsProjProperty: TClientDataSet;
+    cdsProjPropertyID: TIntegerField;
+    cdsProjPropertyName: TWideStringField;
+    cdsProjPropertyItemValue: TWideStringField;
+    atProjData: TADOTable;
+    dspProjData: TDataSetProvider;
+    cdsProjData: TClientDataSet;
+    cdsProjDataBuildProjectID: TIntegerField;
+    cdsProjDataBuildProjectName: TWideStringField;
+    cdsProjDataProjectLocation: TWideStringField;
+    cdsProjDataBuildUnit: TWideStringField;
+    cdsProjDataAuthorUnit: TWideStringField;
+    cdsProjDataBidder: TWideStringField;
+    cdsProjDataAuthor: TWideStringField;
+    cdsProjDataAuthorCertificate: TWideStringField;
+    cdsProjDataAuditor: TWideStringField;
+    cdsProjDataAuditorCertificate: TWideStringField;
+    cdsProjDataBudgetProjectName: TWideStringField;
+    cdsProjDataEditRange: TWideStringField;
+    cdsProjDataEditDate: TDateTimeField;
+    cdsProjDataMachineBBFeeRate: TFloatField;
+    cdsProjDataFZFeeRate: TFloatField;
+    cdsProjDataIsCalcGYFeeRate: TBooleanField;
+    cdsProjDataRoadLength: TFloatField;
+    cdsProjDataAvgMaintMonth: TFloatField;
+    cdsProjDataRoadClass: TIntegerField;
+    cdsProjDataIsNew: TBooleanField;
+    cdsProjDataLandForm: TIntegerField;
+    cdsProjDataDJZG: TFloatField;
+    cdsProjDataYJZG: TFloatField;
+    cdsProjDataNightZG: TFloatField;
+    cdsProjDataRaiseRateByYear: TFloatField;
+    cdsProjDataRaiseYear: TFloatField;
+    cdsProjDataBuildManageFeeFile: TIntegerField;
+  private
+    FConnection: TADOConnection;
+    procedure SetConnection(const Value: TADOConnection);
+    procedure SetActive(const Value: Boolean);
+    function GetActive: Boolean;
+
+    procedure CheckActive;
+    procedure EditProperty(aProjType: Integer);
+    procedure EditProjData;
+    property Active: Boolean read GetActive write SetActive;
+  public
+    property Connection: TADOConnection read FConnection write SetConnection;
+    procedure EditProjProperty(aProjType: Integer);
+    procedure Save;
+    function GetProjectType: Integer;
+  end;
+
+implementation
+
+uses
+  Math, ConstVarUnit;
+
+{$R *.dfm}
+
+{ TProjPropertyDM }
+
+procedure TProjPropertyDM.CheckActive;
+begin
+  if not Active then
+    Active := True;
+end;
+
+procedure TProjPropertyDM.EditProjData;
+begin
+  cdsProjData.First;
+  while not cdsProjData.Eof do
+  begin
+    cdsProjData.Edit;
+    cdsProjDataEditDate.Value := Now;
+    cdsProjData.Post;
+    cdsProjData.Next;
+  end;
+end;
+
+procedure TProjPropertyDM.EditProjProperty(aProjType: Integer);
+begin
+  CheckActive;
+  EditProperty(aProjType);
+  EditProjData;
+end;
+
+procedure TProjPropertyDM.EditProperty(aProjType: Integer);
+begin
+  cdsProjProperty.First;
+  while not cdsProjProperty.Eof do
+  begin
+    if cdsProjPropertyName.Value = sProjType then
+    begin
+      cdsProjProperty.Edit;
+      cdsProjPropertyItemValue.Value := IntToStr(aProjType);
+      cdsProjProperty.Post;
+      Break;
+    end;
+    cdsProjProperty.Next;
+  end;
+end;
+
+function TProjPropertyDM.GetActive: Boolean;
+begin
+  Result := cdsProjProperty.Active and cdsProjData.Active; 
+end;
+
+function TProjPropertyDM.GetProjectType: Integer;
+begin
+  Result := -1;
+  cdsProjProperty.First;
+  while not cdsProjProperty.Eof do
+  begin
+    if cdsProjPropertyName.Value = sProjType then
+    begin
+      Result := StrToIntDef(cdsProjPropertyItemValue.Value, 1);
+      Break;
+    end;
+    cdsProjProperty.Next;
+  end;
+end;
+
+procedure TProjPropertyDM.Save;
+begin
+  cdsProjProperty.ApplyUpdates(0);
+  cdsProjData.ApplyUpdates(0);
+end;
+
+procedure TProjPropertyDM.SetActive(const Value: Boolean);
+begin
+  cdsProjProperty.Active := Value;
+  cdsProjData.Active := Value;
+end;
+
+procedure TProjPropertyDM.SetConnection(const Value: TADOConnection);
+begin
+  FConnection := Value;
+  if Assigned(FConnection) then
+  begin
+    atProjProperty.Connection := FConnection;
+    atProjData.Connection := FConnection;
+    { TODO : open cds }
+    Active := True;
+  end;
+end;
+
+end.

+ 164 - 0
DB/RecycleBinDM.dfm

@@ -0,0 +1,164 @@
+object RecycleBinData: TRecycleBinData
+  OldCreateOrder = False
+  OnCreate = DataModuleCreate
+  OnDestroy = DataModuleDestroy
+  Left = 867
+  Top = 347
+  Height = 236
+  Width = 307
+  object atRecycleBin: TADOTable
+    TableName = 'RecycleBin'
+    Left = 40
+    Top = 24
+  end
+  object cdsRecycleBin: TClientDataSet
+    Aggregates = <>
+    Params = <>
+    ProviderName = 'dspRecycleBin'
+    AfterScroll = cdsRecycleBinAfterScroll
+    Left = 219
+    Top = 24
+    object cdsRecycleBinID: TIntegerField
+      FieldName = 'ID'
+    end
+    object cdsRecycleBinName: TWideStringField
+      FieldName = 'Name'
+      Size = 50
+    end
+    object cdsRecycleBinCreateTime: TWideStringField
+      FieldName = 'CreateTime'
+    end
+    object cdsRecycleBinFileName: TWideStringField
+      FieldName = 'FileName'
+      Size = 255
+    end
+  end
+  object dspRecycleBin: TDataSetProvider
+    DataSet = atRecycleBin
+    UpdateMode = upWhereKeyOnly
+    Left = 126
+    Top = 24
+  end
+  object cdsBills: TClientDataSet
+    Active = True
+    Aggregates = <>
+    Params = <>
+    AfterScroll = cdsBillsAfterScroll
+    Left = 35
+    Top = 128
+    Data = {
+      6A0100009619E0BD01000000180000000D0000000000030000006A0102494404
+      0001000000000008506172656E74494404000100000000000D4E657874536962
+      6C696E674944040001000000000004436F646501004A00000001000557494454
+      48020002006400044E616D6501004A000000010005574944544802000200C800
+      05556E69747301004A0000000100055749445448020002006400085175616E74
+      69747908000400000000000E44657369676E5175616E74697479080004000000
+      00000F44657369676E5175616E7469747932080004000000000009556E697450
+      726963650C0005000000020008444543494D414C530200020004000557494454
+      480200020013000B44657369676E507269636508000400000000000A546F7461
+      6C50726963650C0005000000020008444543494D414C53020002000400055749
+      445448020002001300074D656D6F53747204004B000000010007535542545950
+      4502004900050054657874000000}
+    object cdsBillsID: TIntegerField
+      FieldName = 'ID'
+    end
+    object cdsBillsParentID: TIntegerField
+      FieldName = 'ParentID'
+    end
+    object cdsBillsNextSiblingID: TIntegerField
+      FieldName = 'NextSiblingID'
+    end
+    object cdsBillsCode: TWideStringField
+      FieldName = 'Code'
+      Size = 50
+    end
+    object cdsBillsName: TWideStringField
+      FieldName = 'Name'
+      Size = 100
+    end
+    object cdsBillsUnits: TWideStringField
+      FieldName = 'Units'
+      Size = 50
+    end
+    object cdsBillsQuantity: TFloatField
+      FieldName = 'Quantity'
+    end
+    object cdsBillsDesignQuantity: TFloatField
+      FieldName = 'DesignQuantity'
+    end
+    object cdsBillsDesignQuantity2: TFloatField
+      FieldName = 'DesignQuantity2'
+    end
+    object cdsBillsUnitPrice: TBCDField
+      FieldName = 'UnitPrice'
+      Precision = 19
+    end
+    object cdsBillsDesignPrice: TFloatField
+      FieldName = 'DesignPrice'
+    end
+    object cdsBillsTotalPrice: TBCDField
+      FieldName = 'TotalPrice'
+      Precision = 19
+    end
+    object cdsBillsMemoStr: TMemoField
+      FieldName = 'MemoStr'
+      BlobType = ftMemo
+    end
+  end
+  object cdsDrawingQuantity: TClientDataSet
+    Active = True
+    Aggregates = <>
+    FieldDefs = <
+      item
+        Name = 'Name'
+        DataType = ftWideString
+        Size = 50
+      end
+      item
+        Name = 'Units'
+        DataType = ftWideString
+        Size = 20
+      end
+      item
+        Name = 'BillsID'
+        DataType = ftInteger
+      end
+      item
+        Name = 'DQuantity1'
+        DataType = ftFloat
+      end
+      item
+        Name = 'MemoContext'
+        DataType = ftWideString
+        Size = 50
+      end>
+    IndexDefs = <>
+    Params = <>
+    StoreDefs = True
+    Left = 128
+    Top = 128
+    Data = {
+      900000009619E0BD0100000018000000050000000000030000009000044E616D
+      6501004A000000010005574944544802000200640005556E69747301004A0000
+      0001000557494454480200020028000742696C6C73494404000100000000000A
+      445175616E746974793108000400000000000B4D656D6F436F6E746578740100
+      4A00000001000557494454480200020064000000}
+    object cdsDrawingQuantityName: TWideStringField
+      FieldName = 'Name'
+      Size = 50
+    end
+    object cdsDrawingQuantityUnits: TWideStringField
+      FieldName = 'Units'
+    end
+    object cdsDrawingQuantityBillsID: TIntegerField
+      FieldName = 'BillsID'
+    end
+    object cdsDrawingQuantityDQuantity1: TFloatField
+      FieldName = 'DQuantity1'
+    end
+    object cdsDrawingQuantityMemoContext: TWideStringField
+      FieldName = 'MemoContext'
+      Size = 50
+    end
+  end
+end

+ 303 - 0
DB/RecycleBinDM.pas

@@ -0,0 +1,303 @@
+unit RecycleBinDM;
+
+interface
+
+uses
+  SysUtils, Classes, DB, Provider, DBClient, ADODB, ZjIDTree,
+  XMLDoc, XMLIntf, ConstVarUnit;
+
+type
+  TRecycleBinData = class(TDataModule)
+    atRecycleBin: TADOTable;
+    cdsRecycleBin: TClientDataSet;
+    dspRecycleBin: TDataSetProvider;
+    cdsRecycleBinID: TIntegerField;
+    cdsRecycleBinName: TWideStringField;
+    cdsBills: TClientDataSet;
+    cdsDrawingQuantity: TClientDataSet;
+    cdsBillsID: TIntegerField;
+    cdsBillsParentID: TIntegerField;
+    cdsBillsNextSiblingID: TIntegerField;
+    cdsBillsUnits: TWideStringField;
+    cdsBillsQuantity: TFloatField;
+    cdsBillsUnitPrice: TBCDField;
+    cdsBillsTotalPrice: TBCDField;
+    cdsBillsDesignQuantity: TFloatField;
+    cdsBillsDesignQuantity2: TFloatField;
+    cdsBillsDesignPrice: TFloatField;
+    cdsBillsMemoStr: TMemoField;
+    cdsBillsCode: TWideStringField;
+    cdsBillsName: TWideStringField;
+    cdsDrawingQuantityName: TWideStringField;
+    cdsDrawingQuantityUnits: TWideStringField;
+    cdsDrawingQuantityBillsID: TIntegerField;
+    cdsDrawingQuantityDQuantity1: TFloatField;
+    cdsDrawingQuantityMemoContext: TWideStringField;
+    cdsRecycleBinCreateTime: TWideStringField;
+    cdsRecycleBinFileName: TWideStringField;
+    procedure DataModuleDestroy(Sender: TObject);
+    procedure DataModuleCreate(Sender: TObject);
+    procedure cdsRecycleBinAfterScroll(DataSet: TDataSet);
+    procedure cdsBillsAfterScroll(DataSet: TDataSet);
+  private
+    FBillsTree: TZjIDTree;
+    FConnection: TADOConnection;
+    FXMLDoc: IXMLDocument;
+    FLoading: Boolean;
+    FFileList: TStrings;
+
+    function GetNewID: Integer;
+    procedure SetConnection(const Value: TADOConnection);
+    procedure RefreshDrawingQuantity(ABillsID: Integer);
+    procedure EmptyDateSets;
+    function CreateXMLDoc: IXMLDocument;
+    procedure LoadBillsAndDrawingQuantity(ANode: IXMLNode);
+    procedure LoadBills(ANode: IXMLNode; AParentID: Integer);
+    procedure LoadDrawingQuantity(ANode: IXMLNode);
+    procedure ConnectBillsTree;
+    procedure DisConnectTree;
+    procedure DeleteFiles;
+  public
+    procedure InsertNode(const AProjName, AName: string);
+    procedure DeleteCurrentNode;
+    procedure ClearNodes;
+    function GetCurrentFileName: string;
+    procedure Save;
+    procedure RefreshBills;
+
+    property Connection: TADOConnection read FConnection write SetConnection;
+    property BillsTree: TZjIDTree read FBillsTree;
+  end;
+
+implementation
+
+uses Variants;
+
+{$R *.dfm}
+
+{ TRecycleBinData }
+
+procedure TRecycleBinData.DeleteCurrentNode;
+begin
+  if cdsRecycleBin.RecordCount > 0 then
+  begin
+    DeleteFile(GetCurrentFileName);
+    FFileList.Delete(FFileList.IndexOf(GetCurrentFileName));
+    cdsRecycleBin.Delete;
+  end;
+end;
+
+function TRecycleBinData.GetCurrentFileName: string;
+var
+  S: string;
+begin
+  S := ExtractFilePath(ParamStr(0)) + cdsRecycleBinFileName.AsString;
+  Result := S;
+end;
+
+function TRecycleBinData.GetNewID: Integer;
+begin
+  cdsRecycleBin.Last;
+  Result := cdsRecycleBinID.AsInteger + 1;
+end;
+
+procedure TRecycleBinData.InsertNode(const AProjName, AName: string);
+var
+  iID: Integer;
+begin
+  FLoading := True;
+  try
+    iID := GetNewID;
+    cdsRecycleBin.Append;
+    cdsRecycleBinID.Value := iID;
+    cdsRecycleBinName.Value := AName;
+    cdsRecycleBinCreateTime.Value := FormatDateTime('yyyyÄêmmÔÂddÈÕhhʱnn·ÖssÃë', Now);
+    cdsRecycleBinFileName.Value := 'RecycleBin\' + AProjName + '\' + AName + '(' + cdsRecycleBinCreateTime.AsString + ').bak';
+    cdsRecycleBin.Post;
+    FFileList.Add(GetCurrentFileName);
+  finally
+    FLoading := False;
+  end;
+end;
+
+procedure TRecycleBinData.Save;
+begin
+  FFileList.Clear;
+  cdsRecycleBin.ApplyUpdates(0);
+end;
+
+procedure TRecycleBinData.SetConnection(const Value: TADOConnection);
+
+begin
+  FConnection := Value;
+  atRecycleBin.Connection := FConnection;
+  cdsRecycleBin.Open;
+end;
+
+procedure TRecycleBinData.DataModuleDestroy(Sender: TObject);
+begin
+  DeleteFiles;
+  FBillsTree.Free;
+  FFileList.Free;
+end;
+
+procedure TRecycleBinData.DataModuleCreate(Sender: TObject);
+begin
+  FBillsTree := TZjIDTree.Create;
+  FBillsTree.KeyFieldName := 'ID';
+  FBillsTree.ParentFieldName := 'ParentID';
+  FBillsTree.NextSiblingFieldName := 'NextSiblingID';
+  FBillsTree.AutoExpand := True;
+  FFileList := TStringList.Create;
+end;
+
+procedure TRecycleBinData.cdsRecycleBinAfterScroll(DataSet: TDataSet);
+begin
+  if not FLoading then
+    RefreshBills;
+end;
+
+procedure TRecycleBinData.cdsBillsAfterScroll(DataSet: TDataSet);
+begin
+  if not FLoading then
+    RefreshDrawingQuantity(cdsBillsID.AsInteger);
+end;
+
+procedure TRecycleBinData.RefreshBills;
+begin
+  if cdsRecycleBin.RecordCount = 0 then Exit;
+
+  if not FileExists(GetCurrentFileName) then Exit;
+  EmptyDateSets;
+  FXMLDoc := CreateXMLDoc;
+  try
+    DisConnectTree;
+    FXMLDoc.LoadFromFile(GetCurrentFileName);
+    LoadBillsAndDrawingQuantity(FXMLDoc.DocumentElement);
+    ConnectBillsTree;
+  finally
+    FXMLDoc := nil;
+  end;
+end;
+
+procedure TRecycleBinData.RefreshDrawingQuantity(ABillsID: Integer);
+begin
+  cdsDrawingQuantity.DisableControls;
+  try
+    cdsDrawingQuantity.Filtered := False;
+    cdsDrawingQuantity.Filter := 'BillsID=' + IntToStr(ABillsID);
+    cdsDrawingQuantity.Filtered := True;
+  finally
+    cdsDrawingQuantity.EnableControls;
+  end;
+end;
+
+function TRecycleBinData.CreateXMLDoc: IXMLDocument;
+begin
+  Result := TXMLDocument.Create(nil) as IXMLDocument;
+  Result.Active := True;
+
+  Result.Encoding := 'gb2312';
+  Result.Options := Result.Options + [doNodeAutoIndent];
+  Result.AddChild('SmartCost');
+end;
+
+procedure TRecycleBinData.EmptyDateSets;
+begin
+  cdsBills.EmptyDataSet;
+  cdsDrawingQuantity.EmptyDataSet;
+end;
+
+procedure TRecycleBinData.LoadBillsAndDrawingQuantity(ANode: IXMLNode);
+begin
+  ANode := ANode.ChildNodes.FindNode(c_BillsList);
+  if Assigned(ANode) and ANode.HasChildNodes then
+    LoadBills(ANode.ChildNodes.First, -1);
+end;
+
+procedure TRecycleBinData.LoadBills(ANode: IXMLNode; AParentID: Integer);
+var
+  strCode: string;
+begin
+  if ANode = nil then Exit;
+
+  if SameText(ANode.NodeName, c_BillsItem) then
+  begin
+    cdsBills.Append;
+    cdsBillsID.Value := ANode.Attributes[c_ID];
+    cdsBillsParentID.Value := AParentID;
+    cdsBillsNextSiblingID.Value := ANode.Attributes[c_NextSiblingID];
+    strCode := VarToStr(ANode.Attributes[c_Code]);
+    if strCode <> '' then
+      cdsBillsCode.Value := strCode
+    else
+      cdsBillsCode.Value := ANode.Attributes[c_BCode];
+    cdsBillsName.Value := VarToStr(ANode.Attributes[c_Name]);
+    cdsBillsUnits.Value := VarToStr(ANode.Attributes[c_Units]);
+    cdsBillsQuantity.Value := ANode.Attributes[c_Quantity];
+    cdsBillsDesignQuantity.Value := ANode.Attributes[c_DesignQuantity1];
+    cdsBillsDesignQuantity2.Value := ANode.Attributes[c_DesignQuantity2];
+    cdsBillsDesignPrice.Value := ANode.Attributes[c_DesignPrice];
+    cdsBillsUnitPrice.Value := ANode.Attributes[c_UnitPrice];
+    cdsBillsTotalPrice.Value := ANode.Attributes[c_TotalPrice];
+    cdsBillsMemoStr.Value := ANode.Attributes[c_MemoString];
+    cdsBills.Post;
+
+    LoadDrawingQuantity(ANode);
+  end;
+
+  if ANode.HasChildNodes then
+    LoadBills(ANode.ChildNodes.First, cdsBillsID.AsInteger);
+  if Assigned(ANode.NextSibling) then
+    LoadBills(ANode.NextSibling, AParentID);
+end;
+
+procedure TRecycleBinData.LoadDrawingQuantity(ANode: IXMLNode);
+var
+  I: Integer;
+  vNode: IXMLNode;
+begin
+  ANode := ANode.ChildNodes.FindNode(c_DrawQList);
+  if ANode = nil then Exit;
+
+  for I := 0 to ANode.ChildNodes.Count - 1 do
+  begin
+    vNode := ANode.ChildNodes[I];
+    cdsDrawingQuantity.Append;
+    cdsDrawingQuantityBillsID.Value := vNode.Attributes[c_BillsID];
+    cdsDrawingQuantityName.Value := vNode.Attributes[c_Name];
+    cdsDrawingQuantityUnits.Value := vNode.Attributes[c_Units];
+    cdsDrawingQuantityDQuantity1.Value := vNode.Attributes[c_DesignQuantity1];
+    cdsDrawingQuantityMemoContext.Value := vNode.Attributes[c_MemoString];
+    cdsDrawingQuantity.Post;
+  end;
+end;
+
+procedure TRecycleBinData.ConnectBillsTree;
+begin
+  FBillsTree.DataSet := cdsBills;
+  FBillsTree.Active := True;
+end;
+
+procedure TRecycleBinData.DisConnectTree;
+begin
+  FBillsTree.DataSet := nil;
+  FBillsTree.Active := False;
+end;
+
+procedure TRecycleBinData.DeleteFiles;
+var
+  I: Integer;
+begin
+  for I := 0 to FFileList.Count - 1 do
+    DeleteFile(FFileList[I]);
+end;
+
+procedure TRecycleBinData.ClearNodes;
+begin
+  cdsRecycleBin.First;
+  while not cdsRecycleBin.Eof do
+    DeleteCurrentNode;
+end;
+
+end.

+ 102 - 0
DB/ScExprsDM.dfm

@@ -0,0 +1,102 @@
+object DMExprs: TDMExprs
+  OldCreateOrder = False
+  Left = 602
+  Top = 277
+  Height = 298
+  Width = 318
+  object atExprs: TADOTable
+    TableName = 'Exprs'
+    Left = 50
+    Top = 33
+  end
+  object dspExprs: TDataSetProvider
+    DataSet = atExprs
+    UpdateMode = upWhereKeyOnly
+    Left = 49
+    Top = 107
+  end
+  object cdsOrgExprs: TClientDataSet
+    Aggregates = <>
+    Params = <>
+    ProviderName = 'dspExprs'
+    AfterOpen = cdsOrgExprsAfterOpen
+    Left = 51
+    Top = 182
+    object cdsOrgExprsMajorID: TIntegerField
+      FieldName = 'MajorID'
+    end
+    object cdsOrgExprsMinorID: TIntegerField
+      FieldName = 'MinorID'
+    end
+    object cdsOrgExprsRecdID: TIntegerField
+      FieldName = 'RecdID'
+    end
+    object cdsOrgExprsExprs: TWideStringField
+      FieldName = 'Exprs'
+      Size = 255
+    end
+    object cdsOrgExprsFlag: TIntegerField
+      FieldName = 'Flag'
+    end
+    object cdsOrgExprsExprsValue: TFloatField
+      FieldName = 'ExprsValue'
+    end
+    object cdsOrgExprsExprs1: TWideStringField
+      FieldName = 'Exprs1'
+      Size = 255
+    end
+    object cdsOrgExprsExprs2: TWideStringField
+      FieldName = 'Exprs2'
+      Size = 255
+    end
+    object cdsOrgExprsExprs3: TWideStringField
+      FieldName = 'Exprs3'
+      Size = 255
+    end
+    object cdsOrgExprsExprs4: TWideStringField
+      FieldName = 'Exprs4'
+      Size = 255
+    end
+  end
+  object cdsExprs: TClientDataSet
+    Aggregates = <>
+    Params = <>
+    Left = 151
+    Top = 183
+    object cdsExprsMajorID: TIntegerField
+      FieldName = 'MajorID'
+    end
+    object cdsExprsMinorID: TIntegerField
+      FieldName = 'MinorID'
+    end
+    object cdsExprsRecdID: TIntegerField
+      FieldName = 'RecdID'
+    end
+    object cdsExprsExprs: TWideStringField
+      FieldName = 'Exprs'
+      Size = 255
+    end
+    object cdsExprsFlag: TIntegerField
+      FieldName = 'Flag'
+    end
+    object cdsExprsExprsValue: TFloatField
+      FieldName = 'ExprsValue'
+    end
+    object cdsExprsExprs1: TWideStringField
+      FieldName = 'Exprs1'
+      Size = 255
+    end
+    object cdsExprsExprs2: TWideStringField
+      FieldName = 'Exprs2'
+      Size = 255
+    end
+    object cdsExprsExprs3: TWideStringField
+      FieldName = 'Exprs3'
+      Size = 255
+    end
+    object cdsExprsExprs4: TWideStringField
+      FieldName = 'Exprs4'
+      Size = 255
+    end
+  end
+end

+ 161 - 0
DB/ScExprsDM.pas

@@ -0,0 +1,161 @@
+unit ScExprsDM;
+
+interface
+
+uses
+  SysUtils, Classes, DBClient, Provider, DB, ADODB;
+
+type
+  TDMExprs = class(TDataModule)
+    atExprs: TADOTable;
+    dspExprs: TDataSetProvider;
+    cdsOrgExprs: TClientDataSet;
+    cdsOrgExprsMajorID: TIntegerField;
+    cdsOrgExprsMinorID: TIntegerField;
+    cdsOrgExprsRecdID: TIntegerField;
+    cdsOrgExprsExprs: TWideStringField;
+    cdsOrgExprsFlag: TIntegerField;
+    cdsOrgExprsExprsValue: TFloatField;
+    cdsOrgExprsExprs2: TWideStringField;
+    cdsOrgExprsExprs3: TWideStringField;
+    cdsOrgExprsExprs4: TWideStringField;
+    cdsOrgExprsExprs1: TWideStringField;
+    cdsExprs: TClientDataSet;
+    cdsExprsMajorID: TIntegerField;
+    cdsExprsMinorID: TIntegerField;
+    cdsExprsRecdID: TIntegerField;
+    cdsExprsExprs: TWideStringField;
+    cdsExprsFlag: TIntegerField;
+    cdsExprsExprsValue: TFloatField;
+    cdsExprsExprs1: TWideStringField;
+    cdsExprsExprs2: TWideStringField;
+    cdsExprsExprs3: TWideStringField;
+    cdsExprsExprs4: TWideStringField;
+    procedure cdsOrgExprsAfterOpen(DataSet: TDataSet);
+  private
+    procedure UpdateOldData;
+
+    function GetConnection: TADOConnection;
+    procedure SetConnection(const Value: TADOConnection);
+  public
+    procedure Save;
+    procedure AddExprs(MajorID, MinorID, RecdID: Integer;
+      const Expression: string; Value: Variant; Flag: Integer; AIndex: Integer = 0);
+    procedure Delete(MajorID, RecdID: Integer); overload;
+    procedure Delete(MajorID, MinorID, RecdID: Integer); overload;      
+    function GetExprs(MajorID, MinorID, RecdID: Integer; AIndex: Integer = 0): string;
+
+    property Connection: TADOConnection read GetConnection write SetConnection;
+  end;
+
+
+implementation
+
+{$R *.dfm}
+
+uses ConstVarUnit, Math;
+
+{ TDMExprs }
+
+procedure TDMExprs.AddExprs(MajorID, MinorID, RecdID: Integer;
+  const Expression: string; Value: Variant; Flag, AIndex: Integer);
+begin
+  if cdsExprs.FindKey([MajorID, MinorID, RecdID]) then
+    cdsExprs.Edit
+  else
+    cdsExprs.Insert;
+
+  cdsExprsMajorID.Value := MajorID;
+  cdsExprsMinorID.Value := MinorID;
+  cdsExprsRecdID.Value := RecdID;
+  case AIndex of
+    0: cdsExprsExprs.Value := Expression;
+    1: cdsExprsExprs1.Value := Expression;
+    2: cdsExprsExprs2.Value := Expression;
+    3: cdsExprsExprs3.Value := Expression;
+    4: cdsExprsExprs4.Value := Expression;
+  end;
+  cdsExprsFlag.Value := Flag;
+  cdsExprsExprsValue.Value := Value;
+  cdsExprs.Post;
+end;
+
+procedure TDMExprs.Delete(MajorID, RecdID: Integer);
+begin
+  cdsOrgExprs.SetRange([MajorID, RecdID], [MajorID, RecdID]);
+  cdsOrgExprs.First;
+  while not cdsOrgExprs.Eof do cdsOrgExprs.Delete;
+  cdsOrgExprs.CancelRange;
+end;
+
+procedure TDMExprs.Delete(MajorID, MinorID, RecdID: Integer);
+begin
+  if cdsExprs.FindKey([MajorID, MinorID, RecdID]) then
+    cdsExprs.Delete;
+end;
+
+function TDMExprs.GetConnection: TADOConnection;
+begin
+  Result := atExprs.Connection;
+end;
+
+function TDMExprs.GetExprs(MajorID, MinorID, RecdID,
+  AIndex: Integer): string;
+begin
+  if cdsExprs.FindKey([MajorID, MinorID, RecdID]) then
+  begin
+    case AIndex of
+      0: Result := cdsExprsExprs.Value;
+      1: Result := cdsExprsExprs1.Value;
+      2: Result := cdsExprsExprs2.Value;
+      3: Result := cdsExprsExprs3.Value;
+      4: Result := cdsExprsExprs4.Value;
+      else Result := '';
+    end;
+  end;
+end;
+
+procedure TDMExprs.Save;
+begin
+  cdsOrgExprs.ApplyUpdates(0);
+end;
+
+procedure TDMExprs.SetConnection(const Value: TADOConnection);
+begin
+  atExprs.Connection := Value;
+  if Assigned(Value) then
+  begin
+    cdsOrgExprs.Active := True;
+    cdsOrgExprs.IndexFieldNames := SMajorRecdID;
+  end;
+end;
+
+procedure TDMExprs.cdsOrgExprsAfterOpen(DataSet: TDataSet);
+begin
+  cdsExprs.CloneCursor(cdsOrgExprs, True);
+  cdsExprs.IndexFieldNames := SMajorMinorRecdID;
+
+  UpdateOldData;
+end;
+
+procedure TDMExprs.UpdateOldData;
+begin
+  cdsExprs.First;
+  while not cdsExprs.Eof do
+  begin
+    if (cdsExprsMajorID.AsInteger = Exprs_Qty_ID) and (cdsExprsMinorID.AsInteger = Exprs_DQty_ID) then
+    begin
+      cdsExprs.Edit;
+      cdsExprsMinorID.AsInteger := Exprs_DQty_ID;
+      cdsExprs.Post;
+    end;
+    if (cdsExprsMajorID.AsInteger = Exprs_Qty_ID) and (cdsExprsMinorID.AsInteger = Exprs_DQty2_ID) then
+    begin
+      cdsExprs.Edit;
+      cdsExprsMinorID.AsInteger := Exprs_DQty2_ID;
+      cdsExprs.Post;
+    end;
+  end;
+end;
+
+end.

+ 40 - 0
DB/ScProvinceFrm.dfm

@@ -0,0 +1,40 @@
+object ScProvinceForm: TScProvinceForm
+  Left = 511
+  Top = 315
+  BorderStyle = bsToolWindow
+  Caption = #30465#20221
+  ClientHeight = 166
+  ClientWidth = 310
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  OldCreateOrder = False
+  Position = poOwnerFormCenter
+  OnCreate = FormCreate
+  PixelsPerInch = 96
+  TextHeight = 13
+  object sgProvince: TStringGrid
+    Left = 0
+    Top = 0
+    Width = 310
+    Height = 166
+    Align = alClient
+    Color = 15792112
+    FixedCols = 0
+    RowCount = 7
+    FixedRows = 0
+    Font.Charset = ANSI_CHARSET
+    Font.Color = 21243
+    Font.Height = -12
+    Font.Name = 'smartSimSun'
+    Font.Style = []
+    ParentFont = False
+    ScrollBars = ssNone
+    TabOrder = 0
+    OnDblClick = sgProvinceDblClick
+    OnDrawCell = sgProvinceDrawCell
+  end
+end

+ 133 - 0
DB/ScProvinceFrm.pas

@@ -0,0 +1,133 @@
+{*******************************************************************************
+    单元名称: ScProvinceFrm.pas
+
+    单元说明: 用于网络版选择省份。
+
+    作者时间: Chenshilong, 2010-11-16 17:27:41
+*******************************************************************************}
+
+
+unit ScProvinceFrm;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, Grids, ExtCtrls;
+
+type
+  TScProvinceForm = class(TForm)
+    sgProvince: TStringGrid;
+    procedure FormCreate(Sender: TObject);
+    procedure sgProvinceDrawCell(Sender: TObject; ACol, ARow: Integer;
+      Rect: TRect; State: TGridDrawState);
+    procedure sgProvinceDblClick(Sender: TObject);
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+    procedure init;
+  end;
+
+  function ExecScProvinceForm(var AProvinceName: string): Boolean;
+
+implementation
+
+{$R *.dfm}
+
+function ExecScProvinceForm(var AProvinceName: string): Boolean;
+var
+  ScPrvForm: TScProvinceForm;
+begin
+  Result := False;
+  ScPrvForm := TScProvinceForm.Create(nil);
+  with ScPrvForm do
+  begin
+    try
+      init;
+      ShowModal;
+      if ModalResult = mrOK then
+      begin
+        AProvinceName := sgProvince.Cells[sgProvince.Col,sgProvince.Row];
+        Result := True;
+      end;
+    finally
+      Free;
+    end;
+  end;
+end;
+
+
+{ TForm1 }
+
+procedure TScProvinceForm.init;
+var i: Integer;
+begin
+  for i := 0 to sgProvince.ColCount - 1 do
+  begin
+    sgProvince.ColWidths[i] := 60;
+  end;
+  for i := 0 to sgProvince.RowCount - 1 do
+  begin
+    sgProvince.RowHeights[i] := 22;
+  end;
+
+  sgProvince.Cells[0, 0] := '甘肃';
+  sgProvince.Cells[1, 0] := '宁夏';
+  sgProvince.Cells[2, 0] := '青海';
+  sgProvince.Cells[3, 0] := '陕西';
+  sgProvince.Cells[4, 0] := '广西';
+  sgProvince.Cells[0, 1] := '河南';
+  sgProvince.Cells[1, 1] := '山西';
+  sgProvince.Cells[2, 1] := '辽宁';
+  sgProvince.Cells[3, 1] := '吉林';
+  sgProvince.Cells[4, 1] := '黑龙江';
+  sgProvince.Cells[0, 2] := '内蒙古';
+  sgProvince.Cells[1, 2] := '安徽';
+  sgProvince.Cells[2, 2] := '江苏';
+  sgProvince.Cells[3, 2] := '上海';
+  sgProvince.Cells[4, 2] := '浙江';
+  sgProvince.Cells[0, 3] := '江西';
+  sgProvince.Cells[1, 3] := '山东';
+  sgProvince.Cells[2, 3] := '贵州';
+  sgProvince.Cells[3, 3] := '四川';
+  sgProvince.Cells[4, 3] := '云南';
+  sgProvince.Cells[0, 4] := '重庆';
+  sgProvince.Cells[1, 4] := '北京';
+  sgProvince.Cells[2, 4] := '福建';
+  sgProvince.Cells[3, 4] := '广东';
+  sgProvince.Cells[4, 4] := '海南';
+  sgProvince.Cells[0, 5] := '河北';
+  sgProvince.Cells[1, 5] := '天津';
+  sgProvince.Cells[2, 5] := '湖北';
+  sgProvince.Cells[3, 5] := '湖南';
+  sgProvince.Cells[4, 5] := '西藏';
+  sgProvince.Cells[0, 6] := '新疆';
+  sgProvince.Cells[1, 6] := '香港';
+  sgProvince.Cells[2, 6] := '澳门';
+  sgProvince.Cells[3, 6] := '台湾';
+end;
+
+procedure TScProvinceForm.FormCreate(Sender: TObject);
+begin
+  init;
+end;
+
+procedure TScProvinceForm.sgProvinceDrawCell(Sender: TObject; ACol, ARow: Integer;
+  Rect: TRect; State: TGridDrawState);
+begin
+  with Sender as TStringGrid do
+  begin
+    Canvas.FillRect(Rect);
+    DrawText(Canvas.Handle, PChar(Cells[ACol, ARow]), Length(Cells[ACol, ARow]),
+      Rect, DT_CENTER or DT_SINGLELINE or DT_VCENTER);
+  end;
+end;
+
+procedure TScProvinceForm.sgProvinceDblClick(Sender: TObject);
+begin
+  ModalResult := mrOK;
+end;
+
+end.
+

BIN
DB/ScReportDM.ddp


+ 110 - 0
DB/ScReportDM.dfm

@@ -0,0 +1,110 @@
+object ReportData: TReportData
+  OldCreateOrder = False
+  Left = 863
+  Top = 300
+  Height = 232
+  Width = 310
+  object cdsProjData: TClientDataSet
+    Aggregates = <>
+    Params = <>
+    Left = 91
+    Top = 16
+    object cdsProjDataBuildProjectID: TIntegerField
+      FieldName = 'BuildProjectID'
+    end
+    object cdsProjDataBuildProjectName: TWideStringField
+      FieldName = 'BuildProjectName'
+      Size = 50
+    end
+    object cdsProjDataProjectLocation: TWideStringField
+      FieldName = 'ProjectLocation'
+      Size = 50
+    end
+    object cdsProjDataBuildUnit: TWideStringField
+      FieldName = 'BuildUnit'
+      Size = 50
+    end
+    object cdsProjDataAuthorUnit: TWideStringField
+      FieldName = 'AuthorUnit'
+      Size = 50
+    end
+    object cdsProjDataBidder: TWideStringField
+      FieldName = 'Bidder'
+      Size = 50
+    end
+    object cdsProjDataAuthor: TWideStringField
+      FieldName = 'Author'
+      Size = 50
+    end
+    object cdsProjDataAuthorCertificate: TWideStringField
+      FieldName = 'AuthorCertificate'
+      Size = 50
+    end
+    object cdsProjDataAuditor: TWideStringField
+      FieldName = 'Auditor'
+      Size = 50
+    end
+    object cdsProjDataAuditorCertificate: TWideStringField
+      FieldName = 'AuditorCertificate'
+      Size = 50
+    end
+    object cdsProjDataBudgetProjectName: TWideStringField
+      FieldName = 'BudgetProjectName'
+      Size = 50
+    end
+    object cdsProjDataEditRange: TWideStringField
+      FieldName = 'EditRange'
+      Size = 50
+    end
+    object cdsProjDataEditDate: TDateTimeField
+      FieldName = 'EditDate'
+    end
+    object cdsProjDataMachineBBFeeRate: TFloatField
+      FieldName = 'MachineBBFeeRate'
+    end
+    object cdsProjDataFZFeeRate: TFloatField
+      FieldName = 'FZFeeRate'
+    end
+    object cdsProjDataIsCalcGYFeeRate: TBooleanField
+      FieldName = 'IsCalcGYFeeRate'
+    end
+    object cdsProjDataRoadLength: TFloatField
+      FieldName = 'RoadLength'
+    end
+    object cdsProjDataAvgMaintMonth: TFloatField
+      FieldName = 'AvgMaintMonth'
+    end
+    object cdsProjDataRoadClass: TIntegerField
+      FieldName = 'RoadClass'
+    end
+    object cdsProjDataIsNew: TBooleanField
+      FieldName = 'IsNew'
+    end
+    object cdsProjDataLandForm: TIntegerField
+      FieldName = 'LandForm'
+    end
+    object cdsProjDataDJZG: TFloatField
+      FieldName = 'DJZG'
+    end
+    object cdsProjDataYJZG: TFloatField
+      FieldName = 'YJZG'
+    end
+    object cdsProjDataNightZG: TFloatField
+      FieldName = 'NightZG'
+    end
+    object cdsProjDataRaiseRateByYear: TFloatField
+      FieldName = 'RaiseRateByYear'
+    end
+    object cdsProjDataRaiseYear: TFloatField
+      FieldName = 'RaiseYear'
+    end
+    object cdsProjDataBuildManageFeeFile: TIntegerField
+      FieldName = 'BuildManageFeeFile'
+    end
+  end
+  object aqSQL: TADOQuery
+    Parameters = <>
+    Left = 16
+    Top = 16
+  end
+end

+ 290 - 0
DB/ScReportDM.pas

@@ -0,0 +1,290 @@
+{*******************************************************************************
+    单元名称: ScReportDM.pas
+
+    单元说明: 报表数据源
+               备注:ItemKind: 预清单1,清清单2,图纸工程量3,用于排序、过滤。
+
+               创建一张临时表,所有报表数据都从这张临时表用SQL语句查得。
+               表1:分项工程量清单:全部数据,预算项目节、清单子目号、图纸工程量。
+               表2-1:工程项目清单:汇总项目的软件上部分看到的预、清(即不含图)。
+               表2-2:工程项目清单(带细目):汇总项目的分项工程量清单。即先汇总生成另外一个项目,再分项工程量清单。
+               表3-1:工程量清单:清单子目号级清单汇总,不含图纸工程量(即去掉预部分,只要清部分,且汇总)。
+               表3-2:工程量清单(带细目):清单子目号级清单汇总,含图纸工程量。
+               其中,表2-1、表2-2,已经脱离了自身,操作另外一个项目。
+
+    作者时间: Chenshilong, 2011-01-07 18:20:56
+
+*******************************************************************************}
+
+
+unit ScReportDM;
+
+interface
+
+uses
+  SysUtils, Classes, DB, ADODB, DBClient;
+
+type
+  TReportData = class(TDataModule)
+    cdsProjData: TClientDataSet;
+    aqSQL: TADOQuery;
+    cdsProjDataBuildProjectID: TIntegerField;
+    cdsProjDataBuildProjectName: TWideStringField;
+    cdsProjDataProjectLocation: TWideStringField;
+    cdsProjDataBuildUnit: TWideStringField;
+    cdsProjDataAuthorUnit: TWideStringField;
+    cdsProjDataBidder: TWideStringField;
+    cdsProjDataAuthor: TWideStringField;
+    cdsProjDataAuthorCertificate: TWideStringField;
+    cdsProjDataAuditor: TWideStringField;
+    cdsProjDataAuditorCertificate: TWideStringField;
+    cdsProjDataBudgetProjectName: TWideStringField;
+    cdsProjDataEditRange: TWideStringField;
+    cdsProjDataEditDate: TDateTimeField;
+    cdsProjDataMachineBBFeeRate: TFloatField;
+    cdsProjDataFZFeeRate: TFloatField;
+    cdsProjDataIsCalcGYFeeRate: TBooleanField;
+    cdsProjDataRoadLength: TFloatField;
+    cdsProjDataAvgMaintMonth: TFloatField;
+    cdsProjDataRoadClass: TIntegerField;
+    cdsProjDataIsNew: TBooleanField;
+    cdsProjDataLandForm: TIntegerField;
+    cdsProjDataDJZG: TFloatField;
+    cdsProjDataYJZG: TFloatField;
+    cdsProjDataNightZG: TFloatField;
+    cdsProjDataRaiseRateByYear: TFloatField;
+    cdsProjDataRaiseYear: TFloatField;
+    cdsProjDataBuildManageFeeFile: TIntegerField;
+  private
+    FProject: TObject;
+    FFirstGetData: Boolean;
+    FConnection: TADOConnection;
+    procedure SetProject(const Value: TObject);
+    function GetReportPath: string;
+//    procedure CreateReportTempTab;
+  public
+    { Public declarations }
+//    function GetReportData(AReportName: string): Boolean;
+
+    constructor Create(AOwner: TComponent); override;
+    procedure RefreshData;
+
+    property Project: TObject read FProject write SetProject;
+    property ReportPath: string read GetReportPath;
+    property FirstGetData: Boolean read FFirstGetData write FFirstGetData;
+    property Connection: TADOConnection read FConnection write FConnection;
+
+  end;
+
+implementation
+
+uses ScProjectManager, Forms, DataBase, ScProgressFrm;
+
+{$R *.dfm}
+
+
+constructor TReportData.Create(AOwner: TComponent);
+begin
+  inherited;
+  FirstGetData := True;
+end;
+
+function TReportData.GetReportPath: string;
+begin
+  Result := ExtractFilePath(Application.ExeName) + 'BillsEditorReports\';
+end;
+
+procedure TReportData.SetProject(const Value: TObject);
+begin
+  FProject := Value;
+  cdsProjData.CloneCursor(TProject(FProject).ProjPropertyDM.cdsProjData, True);
+  FConnection := TProject(FProject).Connection;
+  aqSQL.Connection := FConnection;
+end;
+
+{  速度太慢,取消临时表机制 //  chenshilong, 2011-11-08
+procedure TReportData.CreateReportTempTab;
+const
+  sName: String = 'ReportTempTab';
+var i: Integer;
+
+  function IsExist(ATabName: string): Boolean;
+  var vSL: TStringList;
+  begin
+    vSL := TStringList.Create;
+    try
+      FConnection.GetTableNames(vSL);
+      if vSL.IndexOf(ATabName) < 0 then
+        Result := False
+      else
+        Result := True;
+    finally
+      vSL.Free;
+    end;
+  end;
+begin
+  i := 0;
+  with TProject(FProject).BillsData do
+    CreateProgressForm(cdsBills.RecordCount + cdsDrawingQuantity.RecordCount);
+
+  try
+    if IsExist(sName) then
+    begin
+      aqSQL.SQL.Clear;
+      aqSQL.SQL.Add('Drop Table ' + sName);
+      aqSQL.ExecSQL;
+    end;
+
+    RefreshProgressForm('正在创建临时表……');
+    aqSQL.SQL.Clear;
+    aqSQL.SQL.Add(Format('Create Table %s (ID Integer, SerialNo Integer, ItemKind Integer, '
+        + 'OrderNo Integer, Code Text(255), B_Code Text(255), Name Text(255), '
+        + 'Units Text (50), Quantity Double, UnitPrice Double, TotalPrice Double, '
+        + 'DesignQuantity Double, DesignQuantity2 Double, '
+        + 'MemoStr Text (255), B_CodeAlpha Text (255))', [sName]));
+    aqSQL.ExecSQL;
+
+    aqSQL.SQL.Clear;
+    aqSQL.SQL.Add('Select * From ' + sName);
+    aqSQL.Open;
+
+    RefreshProgressForm('正在生成临时表数据:');
+    with TProject(FProject).BillsData do
+    begin
+      cdsBills.First;
+      while not cdsBills.Eof do
+      begin
+        aqSQL.Append;
+        aqSQL.FieldByName('ID').AsInteger := cdsBillsID.AsInteger;
+        aqSQL.FieldByName('SerialNo').AsInteger := cdsBillsSerialNo.AsInteger;
+        // ItemKind: 预清单1,清清单2,图纸工程量3,用于排序、过滤
+        if Trim(cdsBillsB_Code.AsString) <> '' then
+        begin
+          aqSQL.FieldByName('ItemKind').AsInteger := 2;
+          // BCodeAlpha字段用于报表3-2:工程量清单(带细目).fr3。作用是统计后按这个字段排序
+          aqSQL.FieldByName('B_CodeAlpha').AsString := FormatBCodeAlpha(cdsBillsB_Code.AsString);
+        end
+        else
+          aqSQL.FieldByName('ItemKind').AsInteger := 1;
+        // OrderNo:排序字段,图纸工程量之间有先后排序
+        aqSQL.FieldByName('OrderNo').AsInteger := 0;
+        aqSQL.FieldByName('Code').AsString := cdsBillsCode.AsString;
+        aqSQL.FieldByName('B_Code').AsString := cdsBillsB_Code.AsString;
+        aqSQL.FieldByName('Name').AsString := cdsBillsName.AsString;
+        aqSQL.FieldByName('Units').AsString := cdsBillsUnits.AsString;
+        aqSQL.FieldByName('Quantity').AsCurrency := cdsBillsQuantity.AsCurrency;
+        aqSQL.FieldByName('DesignQuantity').AsCurrency := cdsBillsDesignQuantity.AsCurrency;
+        aqSQL.FieldByName('DesignQuantity2').AsCurrency := cdsBillsDesignQuantity2.AsCurrency;
+        aqSQL.FieldByName('UnitPrice').AsCurrency := cdsBillsUnitPrice.AsCurrency;
+        aqSQL.FieldByName('TotalPrice').AsCurrency := cdsBillsTotalPrice.AsCurrency;
+        aqSQL.FieldByName('MemoStr').AsString := cdsBillsMemoStr.AsString;
+        aqSQL.Post;
+        Inc(i);
+        AddProgressForm(1, '正在生成临时表数据:' + IntToStr(i));
+        cdsBills.Next;
+      end;
+
+      cdsDrawingQuantity.First;
+      while not cdsDrawingQuantity.Eof do
+      begin
+        aqSQL.Append;
+        if cdsBillsLookup.Locate('ID', cdsDrawingQuantityBillsID.AsInteger, []) then
+        begin
+          // 图纸工程量的SerialNo取所属清单的SerialNo,以保证能和清单排在一起。
+          aqSQL.FieldByName('SerialNo').AsInteger := cdsBillsLookupSerialNo.AsInteger;
+           aqSQL.FieldByName('B_CodeAlpha').AsString := FormatBCodeAlpha(cdsBillsLookupB_Code.AsString);
+        end;
+
+        aqSQL.FieldByName('ItemKind').AsInteger := 3;
+        aqSQL.FieldByName('OrderNo').AsInteger := cdsDrawingQuantitySerinalNo.AsInteger;
+        aqSQL.FieldByName('Name').AsString := cdsDrawingQuantityName.AsString;
+        aqSQL.FieldByName('Units').AsString := cdsDrawingQuantityUnits.AsString;
+        aqSQL.FieldByName('Quantity').AsCurrency := 0;
+        aqSQL.FieldByName('DesignQuantity').AsCurrency := cdsDrawingQuantityDQuantity1.AsCurrency;
+        aqSQL.FieldByName('DesignQuantity2').AsCurrency := cdsDrawingQuantityDQuantity2.AsCurrency;
+        aqSQL.Post;
+        Inc(i);
+        AddProgressForm(1, '正在生成临时表数据:' + IntToStr(i));
+        cdsDrawingQuantity.Next;
+      end;
+    end;
+  finally
+    CloseProgressForm;
+  end;
+end;  }
+
+{
+function TReportData.GetReportData(AReportName: string): Boolean;
+var sSQL: string;
+  procedure ExecSQL(ASQL: string);
+  begin
+    aqReport.Close;
+    aqReport.SQL.Clear;
+    aqReport.SQL.Add(ASQL);
+    aqReport.Open;
+  end;
+begin
+  Result := False;
+  // 这里加冒号判断是因为防止“表1-2”匹配“表1”等类似的情况
+
+  // 表1:分项工程量清单.fr3, 表2-2:工程项目清单(带细目).fr3
+  if (Pos('表1:', AReportName) > 0) or (Pos('表2-2:', AReportName) > 0) then
+    sSQL := 'select * from ReportTempTab order by SerialNo, ItemKind, OrderNo'
+  // 表2-1:项目工程量清单(标准).fr3
+  else if Pos('表2-1:', AReportName) > 0 then
+    sSQL := 'select * from ReportTempTab where ItemKind <> 3 order by SerialNo, ItemKind, OrderNo'
+  // 表3-1:工程量清单(标准).fr3
+  else if Pos('表3-1:', AReportName) > 0 then
+    sSQL := 'Select B_Code, Name, Units, B_CodeAlpha, Sum(Quantity2) as Quantity, ' +
+            'Sum(TotalPrice2) as TotalPrice, IIF(Quantity=0, 0, TotalPrice / Quantity) as UnitPrice ' +
+            'from (select B_Code, Name, Units, B_CodeAlpha, ' +
+            '0 as Quantity2, Sum(TotalPrice) as TotalPrice2 ' +
+            'from ReportTempTab where ItemKind = 2 ' +
+            'Group by B_Code, Name, Units, B_CodeAlpha ' +
+            'union all ' +
+            'select B_Code, Name, Units, B_CodeAlpha, ' +
+            'Sum(Quantity) as Quantity2, 0 as TotalPrice ' +
+            'from ReportTempTab ' +
+            'where ItemKind = 2 and SerialNo < (select SerialNo from ReportTempTab where ID = 2) ' +
+            'Group by B_Code, Name, Units, B_CodeAlpha) ' +
+            'Group by B_Code, Name, Units, B_CodeAlpha ' +
+            'Order by B_CodeAlpha, Name'
+
+  // 表3-2:工程量清单(带细目).fr3
+  // 数据库中,清单级清单用Quantity,图纸工程量用DesignQuantity,是两个互斥字段,一者有值
+  // 则另一者必定为0。相加是为了报表显示共用一个字段。
+  else if Pos('表3-2:', AReportName) > 0 then
+    sSQL := 'select B_Code, Name, Units, B_CodeAlpha, ItemKind, ' +
+            'Sum(Quantity2) as Quantity, Sum(TotalPrice2) as TotalPrice, ' +
+            'IIF(Quantity=0, 0, TotalPrice / Quantity) as UnitPrice ' +
+            'from(select B_Code, Name, Units, B_CodeAlpha, ItemKind, ' +
+            'Sum(Quantity + DesignQuantity) as Quantity2, 0 as TotalPrice2 ' +
+            'from ReportTempTab where (B_CodeAlpha <> '''') and ' +
+            'SerialNo < (select SerialNo from ReportTempTab where ID = 2) ' +
+            'Group by B_Code, Name, Units, B_CodeAlpha, ItemKind ' +
+            'union all ' +
+            'select B_Code, Name, Units, B_CodeAlpha, ItemKind, ' +
+            '0 as Quantity2, Sum(TotalPrice) as TotalPrice2 ' +
+            'from ReportTempTab where B_CodeAlpha <> ''''' +
+            'Group by B_Code, Name, Units, B_CodeAlpha, ItemKind) ' +
+            'Group by B_Code, Name, Units, B_CodeAlpha, ItemKind ' +
+            'Order by B_CodeAlpha, ItemKind'
+  else
+  // 未定义的报表,不处理
+    Exit;
+
+  ExecSQL(sSQL);
+  Result := True;
+end;   }
+
+procedure TReportData.RefreshData;
+begin
+  with TProject(FProject) do
+  begin
+    BillsData.SaveSerialNo;
+    ChangedByReport := True;
+  //  CreateReportTempTab;
+  end;
+end;
+
+end.

+ 740 - 0
DB/StdBillsLibDM.dfm

@@ -0,0 +1,740 @@
+object DMStdBillsLib: TDMStdBillsLib
+  OldCreateOrder = False
+  OnCreate = DataModuleCreate
+  OnDestroy = DataModuleDestroy
+  Left = 447
+  Top = 238
+  Height = 432
+  Width = 906
+  object acnBillsLib: TADOConnection
+    LoginPrompt = False
+    Mode = cmShareDenyNone
+    Provider = 'Microsoft.Jet.OLEDB.4.0'
+    Left = 32
+    Top = 32
+  end
+  object atBillsLib: TADOTable
+    Connection = acnBillsLib
+    CursorType = ctStatic
+    TableName = 'BillsTree'
+    Left = 112
+    Top = 32
+  end
+  object dspBillsLib: TDataSetProvider
+    DataSet = atBillsLib
+    Left = 112
+    Top = 79
+  end
+  object cdsBillsLib: TClientDataSet
+    Aggregates = <>
+    FieldDefs = <
+      item
+        Name = 'ID'
+        DataType = ftInteger
+      end
+      item
+        Name = 'ParentID'
+        DataType = ftInteger
+      end
+      item
+        Name = 'NextID'
+        DataType = ftInteger
+      end
+      item
+        Name = 'Code'
+        DataType = ftWideString
+        Size = 16
+      end
+      item
+        Name = 'B_Code'
+        DataType = ftWideString
+        Size = 16
+      end
+      item
+        Name = 'Name'
+        DataType = ftWideString
+        Size = 100
+      end
+      item
+        Name = 'Unit'
+        DataType = ftWideString
+        Size = 12
+      end
+      item
+        Name = 'StaticID'
+        DataType = ftInteger
+      end
+      item
+        Name = 'Expr'
+        DataType = ftWideString
+        Size = 50
+      end
+      item
+        Name = 'note'
+        DataType = ftWideString
+        Size = 50
+      end
+      item
+        Name = 'fee'
+        DataType = ftWideString
+        Size = 50
+      end>
+    IndexDefs = <>
+    Params = <>
+    ProviderName = 'dspBillsLib'
+    StoreDefs = True
+    AfterOpen = cdsBillsLibAfterOpen
+    AfterClose = cdsBillsLibAfterClose
+    Left = 112
+    Top = 126
+    object cdsBillsLibID: TIntegerField
+      FieldName = 'ID'
+    end
+    object cdsBillsLibParentID: TIntegerField
+      FieldName = 'ParentID'
+    end
+    object cdsBillsLibNextID: TIntegerField
+      FieldName = 'NextID'
+    end
+    object cdsBillsLibCode: TWideStringField
+      DisplayWidth = 50
+      FieldName = 'Code'
+      Size = 50
+    end
+    object cdsBillsLibB_Code: TWideStringField
+      FieldName = 'B_Code'
+      Size = 16
+    end
+    object cdsBillsLibName: TWideStringField
+      FieldName = 'Name'
+      Size = 100
+    end
+    object cdsBillsLibUnit: TWideStringField
+      FieldName = 'Unit'
+      Size = 12
+    end
+    object cdsBillsLibStaticID: TIntegerField
+      FieldName = 'StaticID'
+    end
+    object cdsBillsLibExpr: TWideStringField
+      FieldName = 'Expr'
+      Size = 50
+    end
+  end
+  object cdsBillsLibView: TClientDataSet
+    Aggregates = <>
+    Params = <>
+    AfterInsert = cdsBillsLibViewAfterInsert
+    AfterPost = cdsBillsLibViewAfterPost
+    Left = 110
+    Top = 181
+    object cdsBillsLibViewID: TIntegerField
+      FieldName = 'ID'
+    end
+    object cdsBillsLibViewParentID: TIntegerField
+      FieldName = 'ParentID'
+    end
+    object cdsBillsLibViewNextID: TIntegerField
+      FieldName = 'NextID'
+    end
+    object cdsBillsLibViewCode: TWideStringField
+      DisplayWidth = 50
+      FieldName = 'Code'
+      OnChange = cdsBillsLibViewCodeChange
+      Size = 50
+    end
+    object cdsBillsLibViewB_Code: TWideStringField
+      FieldName = 'B_Code'
+      OnChange = cdsBillsLibViewCodeChange
+      Size = 16
+    end
+    object cdsBillsLibViewName: TWideStringField
+      FieldName = 'Name'
+      OnChange = cdsBillsLibViewCodeChange
+      Size = 100
+    end
+    object cdsBillsLibViewUnit: TWideStringField
+      FieldName = 'Unit'
+      OnChange = cdsBillsLibViewCodeChange
+      Size = 12
+    end
+    object cdsBillsLibViewStaticID: TIntegerField
+      FieldName = 'StaticID'
+    end
+    object cdsBillsLibViewExpr: TWideStringField
+      FieldName = 'Expr'
+      Size = 50
+    end
+  end
+  object atDrawingQuantity: TADOTable
+    Connection = acnBillsLib
+    CursorType = ctStatic
+    TableName = 'DrawingQuantity'
+    Left = 259
+    Top = 27
+  end
+  object dspDrawingQuantity: TDataSetProvider
+    DataSet = atDrawingQuantity
+    Left = 259
+    Top = 74
+  end
+  object cdsDrawingQuantity: TClientDataSet
+    Aggregates = <>
+    Params = <>
+    ProviderName = 'dspDrawingQuantity'
+    AfterOpen = cdsDrawingQuantityAfterOpen
+    Left = 260
+    Top = 121
+    object cdsDrawingQuantityID: TIntegerField
+      FieldName = 'ID'
+    end
+    object cdsDrawingQuantityName: TWideStringField
+      FieldName = 'Name'
+      Size = 100
+    end
+    object cdsDrawingQuantityUnits: TWideStringField
+      FieldName = 'Units'
+    end
+    object cdsDrawingQuantityDesignQuantity: TFloatField
+      FieldName = 'DesignQuantity'
+    end
+    object cdsDrawingQuantityDesignQuantity2: TFloatField
+      FieldName = 'DesignQuantity2'
+    end
+    object cdsDrawingQuantityMemoStr: TWideStringField
+      FieldName = 'MemoStr'
+      Size = 100
+    end
+    object cdsDrawingQuantityBillsID: TIntegerField
+      FieldName = 'BillsID'
+    end
+  end
+  object dspCustomStep: TDataSetProvider
+    DataSet = atCustomStep
+    Left = 418
+    Top = 127
+  end
+  object cdsCustomStep: TClientDataSet
+    Aggregates = <>
+    Params = <>
+    ProviderName = 'dspCustomStep'
+    Left = 419
+    Top = 179
+    object cdsCustomStepID: TIntegerField
+      FieldName = 'ID'
+    end
+    object cdsCustomStepFmtName: TWideStringField
+      FieldName = 'FmtName'
+      Size = 100
+    end
+    object cdsCustomStepStartValue: TFloatField
+      FieldName = 'StartValue'
+    end
+    object cdsCustomStepStepValue: TFloatField
+      FieldName = 'StepValue'
+    end
+    object cdsCustomStepBillsCode: TWideStringField
+      FieldName = 'BillsCode'
+      Size = 50
+    end
+    object cdsCustomStepIsCode: TBooleanField
+      FieldName = 'IsCode'
+    end
+    object cdsCustomStepDisName: TWideStringField
+      FieldName = 'DisName'
+      Size = 100
+    end
+    object cdsCustomStepUnits: TWideStringField
+      FieldName = 'Units'
+    end
+    object cdsCustomStepOldValue: TFloatField
+      FieldName = 'OldValue'
+    end
+    object cdsCustomStepStartCodeID: TIntegerField
+      FieldName = 'StartCodeID'
+    end
+    object cdsCustomStepFmtName2: TWideStringField
+      FieldName = 'FmtName2'
+      Size = 100
+    end
+    object cdsCustomStepSubArea: TBooleanField
+      FieldName = 'SubArea'
+    end
+  end
+  object atCustomStep: TADOTable
+    Connection = acCustomStep
+    CursorType = ctStatic
+    TableName = 'CustomStep'
+    Left = 417
+    Top = 76
+  end
+  object cdsDrawQView: TClientDataSet
+    Aggregates = <>
+    Params = <>
+    OnNewRecord = cdsDrawQViewNewRecord
+    Left = 253
+    Top = 180
+    object cdsDrawQViewID: TIntegerField
+      FieldName = 'ID'
+    end
+    object cdsDrawQViewName: TWideStringField
+      FieldName = 'Name'
+      Size = 100
+    end
+    object cdsDrawQViewUnits: TWideStringField
+      FieldName = 'Units'
+    end
+    object cdsDrawQViewDesignQuantity: TFloatField
+      FieldName = 'DesignQuantity'
+    end
+    object cdsDrawQViewDesignQuantity2: TFloatField
+      FieldName = 'DesignQuantity2'
+    end
+    object cdsDrawQViewMemoStr: TWideStringField
+      FieldName = 'MemoStr'
+      Size = 100
+    end
+    object cdsDrawQViewBillsID: TIntegerField
+      FieldName = 'BillsID'
+    end
+  end
+  object dsBillsDQ: TDataSource
+    DataSet = cdsBillsLibView
+    Left = 179
+    Top = 180
+  end
+  object cdsStaticID: TClientDataSet
+    Aggregates = <>
+    Params = <>
+    Left = 111
+    Top = 236
+    object cdsStaticIDID: TIntegerField
+      FieldName = 'ID'
+    end
+    object cdsStaticIDName: TWideStringField
+      FieldName = 'Name'
+      Size = 100
+    end
+    object cdsStaticIDStaticID: TIntegerField
+      FieldName = 'StaticID'
+    end
+  end
+  object cdsDQSetRange: TClientDataSet
+    Aggregates = <>
+    Params = <>
+    Left = 255
+    Top = 231
+    object cdsDQSetRangeID: TIntegerField
+      FieldName = 'ID'
+    end
+    object cdsDQSetRangeName: TWideStringField
+      FieldName = 'Name'
+      Size = 100
+    end
+    object cdsDQSetRangeUnits: TWideStringField
+      FieldName = 'Units'
+    end
+    object cdsDQSetRangeDesignQuantity: TFloatField
+      FieldName = 'DesignQuantity'
+    end
+    object cdsDQSetRangeDesignQuantity2: TFloatField
+      FieldName = 'DesignQuantity2'
+    end
+    object cdsDQSetRangeMemoStr: TWideStringField
+      FieldName = 'MemoStr'
+      Size = 100
+    end
+    object cdsDQSetRangeBillsID: TIntegerField
+      FieldName = 'BillsID'
+    end
+  end
+  object cdsCustomStepView: TClientDataSet
+    Active = True
+    Aggregates = <>
+    FieldDefs = <
+      item
+        Name = 'FmtName'
+        DataType = ftWideString
+        Size = 100
+      end
+      item
+        Name = 'StartValue'
+        DataType = ftFloat
+      end
+      item
+        Name = 'StepValue'
+        DataType = ftFloat
+      end
+      item
+        Name = 'BillsCode'
+        DataType = ftWideString
+        Size = 50
+      end
+      item
+        Name = 'IsCode'
+        DataType = ftBoolean
+      end
+      item
+        Name = 'DisName'
+        DataType = ftWideString
+        Size = 100
+      end
+      item
+        Name = 'Units'
+        DataType = ftWideString
+        Size = 20
+      end
+      item
+        Name = 'CustomValue'
+        DataType = ftFloat
+      end
+      item
+        Name = 'OldValue'
+        DataType = ftFloat
+      end
+      item
+        Name = 'StartCodeID'
+        DataType = ftInteger
+      end
+      item
+        Name = 'CustomBillsCode'
+        DataType = ftWideString
+        Size = 20
+      end
+      item
+        Name = 'FmtName2'
+        DataType = ftWideString
+        Size = 100
+      end
+      item
+        Name = 'SubArea'
+        DataType = ftBoolean
+      end>
+    IndexDefs = <>
+    Params = <>
+    StoreDefs = True
+    BeforeInsert = cdsCustomStepViewBeforeInsert
+    AfterPost = cdsCustomStepViewAfterPost
+    BeforeDelete = cdsCustomStepViewBeforeDelete
+    Left = 421
+    Top = 226
+    Data = {
+      480100009619E0BD01000000180000000D000000000003000000480107466D74
+      4E616D6501004A000000010005574944544802000200C8000A53746172745661
+      6C75650800040000000000095374657056616C75650800040000000000094269
+      6C6C73436F646501004A0000000100055749445448020002006400064973436F
+      64650200030000000000074469734E616D6501004A0000000100055749445448
+      02000200C80005556E69747301004A0000000100055749445448020002002800
+      0B437573746F6D56616C75650800040000000000084F6C6456616C7565080004
+      00000000000B5374617274436F6465494404000100000000000F437573746F6D
+      42696C6C73436F646501004A000000010005574944544802000200280008466D
+      744E616D653201004A000000010005574944544802000200C800075375624172
+      656102000300000000000000}
+    object cdsCustomStepViewFmtName: TWideStringField
+      FieldName = 'FmtName'
+      Size = 100
+    end
+    object cdsCustomStepViewStartValue: TFloatField
+      FieldName = 'StartValue'
+    end
+    object cdsCustomStepViewStepValue: TFloatField
+      FieldName = 'StepValue'
+    end
+    object cdsCustomStepViewBillsCode: TWideStringField
+      FieldName = 'BillsCode'
+      Size = 50
+    end
+    object cdsCustomStepViewIsCode: TBooleanField
+      FieldName = 'IsCode'
+    end
+    object cdsCustomStepViewDisName: TWideStringField
+      FieldName = 'DisName'
+      Size = 100
+    end
+    object cdsCustomStepViewUnits: TWideStringField
+      FieldName = 'Units'
+    end
+    object cdsCustomStepViewCustomValue: TFloatField
+      FieldName = 'CustomValue'
+      OnChange = cdsCustomStepViewCustomValueChange
+    end
+    object cdsCustomStepViewOldValue: TFloatField
+      FieldName = 'OldValue'
+    end
+    object cdsCustomStepViewStartCodeID: TIntegerField
+      FieldName = 'StartCodeID'
+    end
+    object cdsCustomStepViewCustomBillsCode: TWideStringField
+      FieldName = 'CustomBillsCode'
+    end
+    object cdsCustomStepViewFmtName2: TWideStringField
+      FieldName = 'FmtName2'
+      Size = 100
+    end
+    object cdsCustomStepViewSubArea: TBooleanField
+      FieldName = 'SubArea'
+    end
+  end
+  object atBillsQty: TADOTable
+    Connection = acnBillsQty
+    TableName = 'BillsTree'
+    Left = 624
+    Top = 27
+  end
+  object dspBillsQty: TDataSetProvider
+    DataSet = atBillsQty
+    Left = 624
+    Top = 71
+  end
+  object cdsBillsQty: TClientDataSet
+    Aggregates = <>
+    Params = <>
+    ProviderName = 'dspBillsQty'
+    AfterOpen = cdsBillsQtyAfterOpen
+    Left = 624
+    Top = 116
+    object cdsBillsQtyID: TIntegerField
+      FieldName = 'ID'
+    end
+    object cdsBillsQtyParentID: TIntegerField
+      FieldName = 'ParentID'
+    end
+    object cdsBillsQtyNextID: TIntegerField
+      FieldName = 'NextID'
+    end
+    object cdsBillsQtyCode: TWideStringField
+      FieldName = 'Code'
+      Size = 16
+    end
+    object cdsBillsQtyB_Code: TWideStringField
+      FieldName = 'B_Code'
+      Size = 50
+    end
+    object cdsBillsQtyName: TWideStringField
+      FieldName = 'Name'
+      Size = 100
+    end
+    object cdsBillsQtyUnit: TWideStringField
+      FieldName = 'Unit'
+      Size = 12
+    end
+    object cdsBillsQtyStaticID: TIntegerField
+      FieldName = 'StaticID'
+    end
+    object cdsBillsQtyExpr: TWideStringField
+      FieldName = 'Expr'
+      Size = 50
+    end
+  end
+  object cdsBillsQtyView: TClientDataSet
+    Aggregates = <>
+    Params = <>
+    AfterInsert = cdsBillsQtyViewAfterInsert
+    AfterPost = cdsBillsQtyViewAfterPost
+    Left = 624
+    Top = 163
+    object cdsBillsQtyViewID: TIntegerField
+      FieldName = 'ID'
+    end
+    object cdsBillsQtyViewParentID: TIntegerField
+      FieldName = 'ParentID'
+    end
+    object cdsBillsQtyViewNextID: TIntegerField
+      FieldName = 'NextID'
+    end
+    object cdsBillsQtyViewCode: TWideStringField
+      FieldName = 'Code'
+      OnChange = cdsBillsLibViewCodeChange
+      Size = 16
+    end
+    object cdsBillsQtyViewB_Code: TWideStringField
+      FieldName = 'B_Code'
+      OnChange = cdsBillsLibViewCodeChange
+      Size = 50
+    end
+    object cdsBillsQtyViewName: TWideStringField
+      FieldName = 'Name'
+      OnChange = cdsBillsLibViewCodeChange
+      Size = 100
+    end
+    object cdsBillsQtyViewUnit: TWideStringField
+      FieldName = 'Unit'
+      OnChange = cdsBillsLibViewCodeChange
+      Size = 12
+    end
+    object cdsBillsQtyViewStaticID: TIntegerField
+      FieldName = 'StaticID'
+    end
+    object cdsBillsQtyViewExpr: TWideStringField
+      FieldName = 'Expr'
+      Size = 50
+    end
+  end
+  object acnBillsQty: TADOConnection
+    LoginPrompt = False
+    Mode = cmShareDenyNone
+    Provider = 'Microsoft.Jet.OLEDB.4.0'
+    Left = 568
+    Top = 27
+  end
+  object acCustomStep: TADOConnection
+    LoginPrompt = False
+    Left = 418
+    Top = 27
+  end
+  object atBQDrawingQty: TADOTable
+    Connection = acnBillsQty
+    TableName = 'DrawingQuantity'
+    Left = 783
+    Top = 24
+  end
+  object dspBQDrawingQty: TDataSetProvider
+    DataSet = atBQDrawingQty
+    UpdateMode = upWhereKeyOnly
+    Left = 783
+    Top = 69
+  end
+  object cdsBQDrawingQty: TClientDataSet
+    Aggregates = <>
+    Params = <>
+    ProviderName = 'dspBQDrawingQty'
+    AfterOpen = cdsBQDrawingQtyAfterOpen
+    Left = 786
+    Top = 112
+    object cdsBQDrawingQtyID: TIntegerField
+      FieldName = 'ID'
+    end
+    object cdsBQDrawingQtyName: TWideStringField
+      FieldName = 'Name'
+      Size = 100
+    end
+    object cdsBQDrawingQtyUnits: TWideStringField
+      FieldName = 'Units'
+    end
+    object cdsBQDrawingQtyDesignQuantity: TFloatField
+      FieldName = 'DesignQuantity'
+    end
+    object cdsBQDrawingQtyDesignQuantity2: TFloatField
+      FieldName = 'DesignQuantity2'
+    end
+    object cdsBQDrawingQtyMemoStr: TWideStringField
+      FieldName = 'MemoStr'
+      Size = 100
+    end
+    object cdsBQDrawingQtyBillsID: TIntegerField
+      FieldName = 'BillsID'
+    end
+  end
+  object cdsBQDrawingQtyView: TClientDataSet
+    Aggregates = <>
+    Params = <>
+    OnNewRecord = cdsBQDrawingQtyViewNewRecord
+    Left = 788
+    Top = 161
+    object cdsBQDrawingQtyViewID: TIntegerField
+      FieldName = 'ID'
+    end
+    object cdsBQDrawingQtyViewName: TWideStringField
+      FieldName = 'Name'
+      Size = 100
+    end
+    object cdsBQDrawingQtyViewUnits: TWideStringField
+      FieldName = 'Units'
+    end
+    object cdsBQDrawingQtyViewDesignQuantity: TFloatField
+      FieldName = 'DesignQuantity'
+    end
+    object cdsBQDrawingQtyViewDesignQuantity2: TFloatField
+      FieldName = 'DesignQuantity2'
+    end
+    object cdsBQDrawingQtyViewMemoStr: TWideStringField
+      FieldName = 'MemoStr'
+      Size = 100
+    end
+    object cdsBQDrawingQtyViewBillsID: TIntegerField
+      FieldName = 'BillsID'
+    end
+  end
+  object dsBillsQty: TDataSource
+    DataSet = cdsBillsQtyView
+    Left = 703
+    Top = 161
+  end
+  object cdsFastSearch: TClientDataSet
+    Aggregates = <>
+    Params = <>
+    Left = 112
+    Top = 296
+    object cdsFastSearchID: TIntegerField
+      FieldName = 'ID'
+    end
+    object cdsFastSearchParentID: TIntegerField
+      FieldName = 'ParentID'
+    end
+    object cdsFastSearchNextID: TIntegerField
+      FieldName = 'NextID'
+    end
+    object cdsFastSearchCode: TWideStringField
+      DisplayWidth = 50
+      FieldName = 'Code'
+      Size = 50
+    end
+    object cdsFastSearchB_Code: TWideStringField
+      FieldName = 'B_Code'
+      Size = 16
+    end
+    object cdsFastSearchName: TWideStringField
+      FieldName = 'Name'
+      Size = 100
+    end
+    object cdsFastSearchUnit: TWideStringField
+      FieldName = 'Unit'
+      Size = 12
+    end
+    object cdsFastSearchStaticID: TIntegerField
+      FieldName = 'StaticID'
+    end
+    object cdsFastSearchExpr: TWideStringField
+      FieldName = 'Expr'
+      Size = 50
+    end
+  end
+  object cdsBQFastSearch: TClientDataSet
+    Aggregates = <>
+    Params = <>
+    Left = 624
+    Top = 224
+    object cdsBQFastSearchID: TIntegerField
+      FieldName = 'ID'
+    end
+    object cdsBQFastSearchParentID: TIntegerField
+      FieldName = 'ParentID'
+    end
+    object cdsBQFastSearchNextID: TIntegerField
+      FieldName = 'NextID'
+    end
+    object cdsBQFastSearchCode: TWideStringField
+      FieldName = 'Code'
+      Size = 16
+    end
+    object cdsBQFastSearchB_Code: TWideStringField
+      FieldName = 'B_Code'
+      Size = 50
+    end
+    object cdsBQFastSearchName: TWideStringField
+      FieldName = 'Name'
+      Size = 100
+    end
+    object cdsBQFastSearchUnit: TWideStringField
+      FieldName = 'Unit'
+      Size = 12
+    end
+    object cdsBQFastSearchStaticID: TIntegerField
+      FieldName = 'StaticID'
+    end
+    object cdsBQFastSearchExpr: TWideStringField
+      FieldName = 'Expr'
+      Size = 50
+    end
+  end
+end

Разница между файлами не показана из-за своего большого размера
+ 1715 - 0
DB/StdBillsLibDM.pas


+ 44 - 0
Dpr/BillsEditor.cfg

@@ -0,0 +1,44 @@
+-$A8
+-$B-
+-$C+
+-$D+
+-$E-
+-$F-
+-$G+
+-$H+
+-$I+
+-$J-
+-$K-
+-$L+
+-$M-
+-$N+
+-$O+
+-$P+
+-$Q-
+-$R-
+-$S-
+-$T-
+-$U-
+-$V+
+-$W-
+-$X+
+-$YD
+-$Z1
+-cg
+-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
+-H+
+-W+
+-M
+-$M16384,1048576
+-K$00400000
+-E"D:\Program Files\李뷘흡숭\밤땜무쨌芚송긍�溝固(깃硫뺏2011)淚撚경"
+-LE"d:\program files\borland\delphi7\Projects\Bpl"
+-LN"d:\program files\borland\delphi7\Projects\Bpl"
+-U"E:\헌데긍齡\Inc"
+-O"E:\헌데긍齡\Inc"
+-I"E:\헌데긍齡\Inc"
+-R"E:\헌데긍齡\Inc"
+-D_ScBudget;_ScGuangDong;_beEncrypt;_ScEncrypt
+-w-UNSAFE_TYPE
+-w-UNSAFE_CODE
+-w-UNSAFE_CAST

Разница между файлами не показана из-за своего большого размера
+ 158 - 0
Dpr/BillsEditor.dof


+ 99 - 0
Dpr/BillsEditor.dpr

@@ -0,0 +1,99 @@
+program BillsEditor;
+
+uses
+  Forms,
+  Windows,
+  SysUtils,
+  MainForm in '..\MF\MainForm.pas' {MainFrm},
+  BillsProjectFrame in '..\MF\BillsProjectFrame.pas' {BillsProjectView: TFrame},
+  StdBillsLibForm in '..\MF\StdBillsLibForm.pas' {StdBillsLibFrm},
+  DataBase in '..\DB\DataBase.pas' {DMDataBase: TDataModule},
+  StdBillsLibDM in '..\DB\StdBillsLibDM.pas' {DMStdBillsLib: TDataModule},
+  ConstMethodUnit in '..\CU\ConstMethodUnit.pas',
+  ConstTypeUnit in '..\CU\ConstTypeUnit.pas',
+  ConstVarUnit in '..\CU\ConstVarUnit.pas',
+  ScAutoUpdateUnit in '..\CU\ScAutoUpdateUnit.pas',
+  ScBillsTree in '..\CU\ScBillsTree.pas',
+  ScCopyBills in '..\CU\ScCopyBills.pas',
+  ScFileArchiver in '..\CU\ScFileArchiver.pas',
+  ScFileProviders in '..\CU\ScFileProviders.pas',
+  ScKindsOfTrees in '..\CU\ScKindsOfTrees.pas',
+  ScProjectManager in '..\CU\ScProjectManager.pas',
+  ScTables in '..\CU\ScTables.pas',
+  ScUpdateDataBase in '..\CU\ScUpdateDataBase.pas',
+  AboutForm in '..\AF\AboutForm.pas' {AboutFrm},
+  CheckPosForm in '..\AF\CheckPosForm.pas' {CheckPosFrm},
+  FlashForm in '..\AF\FlashForm.pas' {flashFrm},
+  ScConfig in '..\CU\ScConfig.pas',
+  ScStdBillsCtrl in '..\CU\ScStdBillsCtrl.pas',
+  ScOptionsFrm in '..\MF\ScOptionsFrm.pas' {frmOptions},
+  HisRestorePointFrm in '..\MF\HisRestorePointFrm.pas' {frmRestorePoint},
+  HisRestorePointDM in '..\DB\HisRestorePointDM.pas' {DMHisRestorePoint: TDataModule},
+  ScEvaluate in '..\CU\ScEvaluate.pas',
+  ScExprsDM in '..\DB\ScExprsDM.pas' {DMExprs: TDataModule},
+  NewProjectFrm in '..\AF\NewProjectFrm.pas' {NewProjectForm},
+  ProjectPropertyDM in '..\DB\ProjectPropertyDM.pas' {ProjPropertyDM: TDataModule},
+  ScEncryptUnit in '..\Encrypt\ScEncryptUnit.pas',
+  ScAuthFrm in '..\AF\ScAuthFrm.pas' {AuthorizeForm},
+  CryptUtils in '..\Encrypt\CryptUtils.pas',
+  ScEncryptEditions in '..\Encrypt\ScEncryptEditions.pas',
+  ScHaspEncrypt in '..\Encrypt\ScHaspEncrypt.pas',
+  ScHaspPwd in '..\Encrypt\ScHaspPWD.pas',
+  ScSNSEncrypt in '..\Encrypt\ScSNSEncrypt.pas',
+  fraFileManagerFrame in '..\MF\fraFileManagerFrame.pas' {FileManagerFrame: TFrame},
+  ProjectManagerDM in '..\DB\ProjectManagerDM.pas' {ProjectMgrDM: TDataModule},
+  ProjectFileManager in '..\CU\ProjectFileManager.pas',
+  CustomDoc in '..\CU\CustomDoc.pas',
+  fraBillsItemsFrame in '..\MF\fraBillsItemsFrame.pas' {BillsItemsFrame: TFrame},
+  ImportExcel in '..\CU\ImportExcel.pas',
+  DetailItemsDM in '..\DB\DetailItemsDM.pas' {DMDetailItems: TDataModule},
+  ExportExcel in '..\CU\ExportExcel.pas',
+  ExportExFrm in '..\AF\ExportExFrm.pas' {ExportExForm},
+  LocateBillsDM in '..\DB\LocateBillsDM.pas' {BillsLocateDM: TDataModule},
+  ProjectPropertyUnit in '..\CU\ProjectPropertyUnit.pas',
+  ProjectPropertyThread in '..\CU\ProjectPropertyThread.pas',
+  ProjectMergeSplitUnit in '..\CU\ProjectMergeSplitUnit.pas',
+  BidLotDM in '..\DB\BidLotDM.pas' {BidLotDataModule: TDataModule},
+  SingleObjectAggregateUnit in '..\CU\SingleObjectAggregateUnit.pas',
+  BidLotAliasFrm in '..\AF\BidLotAliasFrm.pas' {BidAliasForm},
+  FXQDManagerUnit in '..\CU\FXQDManagerUnit.pas',
+  CommonIntfUnit in '..\CU\CommonIntfUnit.pas',
+  FileOprUnit in '..\CU\FileOprUnit.pas',
+  StdLibsManagerFrm in '..\AF\StdLibsManagerFrm.pas' {StdLibsManagerForm},
+  ExportDecorateUnit in '..\CU\ExportDecorateUnit.pas',
+  ScReportDM in '..\DB\ScReportDM.pas' {ReportData: TDataModule},
+  ScProgressFrm in '..\MF\ScProgressFrm.pas' {ProgressFrm2},
+  ScCustomSetErrorFrm in '..\MF\ScCustomSetErrorFrm.pas' {ScCustomSetErrorForm},
+  ScReportsFrm in '..\Reports\UI\ScReportsFrm.pas' {ScReportsForm},
+  ScWorkListFrm in '..\Reports\UI\ScWorkListFrm.pas' {ScWorkListForm},
+  ReportAdjusterUnit in '..\Reports\Config\ReportAdjusterUnit.pas' {ReportAdjuster},
+  CommonMessages in '..\..\SmartCost\Common\CommonMessages.pas',
+  ScGatherProjFrm in '..\MF\ScGatherProjFrm.pas' {GatherProjForm};
+
+{$R *.res}
+
+var
+  FlashWin: TflashFrm;
+  sProcessName: string;
+
+begin
+  sProcessName := 'BillsEditor.exe'; // ExtractFileName(ParamStr(0));  
+  if ProcessIsRunning(sProcessName) = 1 then
+  begin
+    Application.Initialize;
+    FlashWin := TflashFrm.Create(nil);
+    FlashWin.Show;
+    FlashWin.Update;
+    Application.Title := '×ݺáÇåµ¥±àÖÆ¹ÜÀíϵͳ';
+    
+    {$IFDEF _beEncrypt}
+    if not IsDogExists then Application.Terminate;
+    {$ENDIF}
+
+    Application.CreateForm(TMainFrm, MainFrm);
+  Application.CreateForm(TReportAdjuster, ReportAdjuster);
+  FlashWin.Hide;
+    FlashWin.Free;
+    Application.Run;
+  end;
+end.

BIN
Dpr/BillsEditor.res


+ 45 - 0
Dpr/Common/BillsEditor.cfg

@@ -0,0 +1,45 @@
+-$A8
+-$B-
+-$C+
+-$D+
+-$E-
+-$F-
+-$G+
+-$H+
+-$I+
+-$J-
+-$K-
+-$L+
+-$M-
+-$N+
+-$O+
+-$P+
+-$Q-
+-$R-
+-$S-
+-$T-
+-$U-
+-$V+
+-$W-
+-$X+
+-$YD
+-$Z1
+-cg
+-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
+-H+
+-W+
+-M
+-$M16384,1048576
+-K$00400000
+-E"E:\SmartcostExe\BillsEditorCommonExe"
+-N"E:\BillsEditor\DCU"
+-LE"d:\program files\borland\delphi7\Projects\Bpl"
+-LN"d:\program files\borland\delphi7\Projects\Bpl"
+-U"E:\BillsEditor\Inc"
+-O"E:\BillsEditor\Inc"
+-I"E:\BillsEditor\Inc"
+-R"E:\BillsEditor\Inc"
+-D_ScBudget;_ScGuangDong;_beCommon;_beEncrypt;_ScEncrypt;_ScBillsEditor
+-w-UNSAFE_TYPE
+-w-UNSAFE_CODE
+-w-UNSAFE_CAST

Разница между файлами не показана из-за своего большого размера
+ 156 - 0
Dpr/Common/BillsEditor.dof


+ 0 - 0
Dpr/Common/BillsEditor.dpr


Некоторые файлы не были показаны из-за большого количества измененных файлов