unit StdBillsLibForm; interface uses Windows, Messages, SysUtils, Classes, Controls, Forms, ZjCells, ZjLists, StdCtrls, ExtCtrls, ZJGrid, ZjGridDBA, ZjGridTreeDBA, DBClient, Provider, DB, ADODB, ZjIDTree, JimPages, ComCtrls, Menus, ImgList, ToolWin, dxBar, XPMenu, Graphics; type TStdBillsLibFrm = class(TForm) zaBillsLib: TZjGridTreeDBA; zaDrawingQuantity: TZjGridDBA; zaBillsQty: TZjGridTreeDBA; JimPages1: TJimPages; JimPages1Page1: TJimPage; JimPages1Page2: TJimPage; PageControl1: TPageControl; TabSheet1: TTabSheet; Splitter1: TSplitter; Panel1: TPanel; btnAdd: TButton; cbFileName: TComboBox; zgBillsLib: TZJGrid; zgDrawingQuantity: TZJGrid; TabSheet2: TTabSheet; Panel2: TPanel; cbbBillsQtyLibs: TComboBox; btnAddQtyItems: TButton; zgBillsQty: TZJGrid; PageControl2: TPageControl; TabSheet3: TTabSheet; zgQtyItems: TZJGrid; zaQtyItems: TZjGridDBA; Panel3: TPanel; letBCode: TLabeledEdit; btnLocate: TButton; btnRefresh: TButton; btnClose: TButton; btnCloseQtyItem: TButton; ldeFindByCode: TLabeledEdit; ldeFindByName: TLabeledEdit; btnFindNext: TButton; zgQtyDrawingItems: TZJGrid; Splitter2: TSplitter; zaQtyDrawingItems: TZjGridDBA; pmBillsLib: TPopupMenu; N1: TMenuItem; N2: TMenuItem; ImageListOfPM: TImageList; N3: TMenuItem; N4: TMenuItem; ToolBar1: TToolBar; btnViewToLevels: TToolButton; dxpmStdShowLevel: TdxBarPopupMenu; XPMenuStdView: TXPMenu; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure zaBillsLibGridGetCellText(Sender: TObject; const ACoord: TPoint; var Value: String); procedure cbFileNameChange(Sender: TObject); procedure zgBillsLibMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure btnAddClick(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure cbbBillsQtyLibsChange(Sender: TObject); procedure zaBillsQtyGridGetCellText(Sender: TObject; const ACoord: TPoint; var Value: String); procedure zaBillsQtyGridSetCellText(Sender: TObject; const ACoord: TPoint; var Value: String); procedure zgBillsQtyMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure btnAddQtyItemsClick(Sender: TObject); procedure btnRefreshClick(Sender: TObject); procedure btnLocateClick(Sender: TObject); procedure letBCodeChange(Sender: TObject); procedure zgQtyItemsMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure btnCloseClick(Sender: TObject); procedure ldeFindByCodeChange(Sender: TObject); procedure btnFindNextClick(Sender: TObject); procedure zaBillsLibGridSetCellText(Sender: TObject; const ACoord: TPoint; var Value: String); procedure DoOnGridCellCanUpLevel(Sender: TObject; const ACoord: TPoint; var Allow: Boolean); procedure DoOnGridCellCanDownLevel(Sender: TObject; const ACoord: TPoint; var Allow: Boolean); procedure N1Click(Sender: TObject); procedure N3Click(Sender: TObject); procedure N4Click(Sender: TObject); procedure btnViewToLevelsClick(Sender: TObject); procedure zgBillsLibCellGetColor(Sender: TObject; ACoord: TPoint; var AColor: TColor); private FSelList : TIntegerSList; FBillsQtyList : TIntegerSList; FLibNameList : TStrings; FBillsQtyLibs : TStrings; FStdBillsCtrl : TObject; FZjIDTree : TZjIDTree; FBillsQtyTree : TZjIDTree; FOpenLibName : string; FFindIndex : Integer; procedure SetDQDataSet(const Value: TDataSet); procedure SetQtyDQDataSet(const Value: TDataSet); procedure SetZjIDTree(const Value: TZjIDTree); procedure SetIncStep(const Value: Integer); function GetCheckCount(aSelList: TIntegerSList): Integer; { TODO : Control progress in need } function ShowProgressor: Boolean; procedure HideProgressor(aShow: Boolean); procedure SetBillsQtyTree(const Value: TZjIDTree); procedure InitView; procedure SetQtyItemDataSet(const Value: TDataSet); public { show page } procedure ShowPage(aPage: Integer); function GetPageIdx: Integer; {} procedure LoadLibNames; { Close } procedure CloseLib(aFileFlag: Integer); procedure ClearFilter; { FX } procedure AddLib(const aShortName: string; aFileFlag: Integer); procedure DeleteLib(const aShortName: string; aFileFlag: Integer); procedure ReNameLib(const aOldName, aNewName: string; aFileFlag: Integer); { control interface refresh } procedure BeginUpdateUI(aType: Integer); procedure EndUpdateUI(aType: Integer); { TODO : FindRecord } procedure FindRecord(var aIndex: Integer; const aCode, aName: string); property ZgIDTree: TZjIDTree read FZjIDTree write SetZjIDTree; property DQDataSet: TDataSet write SetDQDataSet; property QtyDQDataSet: TDataSet write SetQtyDQDataSet; property BillsQtyTree: TZjIDTree write SetBillsQtyTree; property QtyItemDataSet: TDataSet write SetQtyItemDataSet; property StdBillsCtrl: TObject read FStdBillsCtrl write FStdBillsCtrl; property IncStep: Integer write SetIncStep; property OpenLibName: string read FOpenLibName; end; implementation {$R *.dfm} uses ConstMethodUnit, ZjIDTreeCells, ScConfig, Math, ScStdBillsCtrl, StdBillsLibDM, LocateBillsDM; procedure TStdBillsLibFrm.FormCreate(Sender: TObject); begin zgBillsLib.CellClass.Cols[0] := TZjCheckBoxCell; zgBillsQty.CellClass.Cols[0] := TZjCheckBoxCell; FSelList := TIntegerSList.Create; FBillsQtyList := TIntegerSList.Create; FBillsQtyLibs := TStringList.Create; { init } InitView; zaBillsQty.OnGridCellCanUpLevel := DoOnGridCellCanUpLevel; zaBillsQty.OnGridCellCanDownLevel := DoOnGridCellCanDownLevel; end; procedure TStdBillsLibFrm.FormDestroy(Sender: TObject); begin FSelList.Free; FBillsQtyList.Free; FBillsQtyLibs.Free; end; procedure TStdBillsLibFrm.zaBillsLibGridGetCellText(Sender: TObject; const ACoord: TPoint; var Value: String); var OldActiveRec: Integer; begin if (ACoord.X = 0) and zaBillsLib.ChangeActiveRecord(ACoord.Y - zgBillsLib.FixedRowCount, OldActiveRec) then begin try Value := ZjBooleanStr(FSelList[ACoord.Y - zgBillsLib.FixedRowCount] <> 0); finally zaBillsLib.ChangeActiveRecord(OldActiveRec, OldActiveRec); end; end; end; procedure TStdBillsLibFrm.cbFileNameChange(Sender: TObject); begin Screen.Cursor := crHourGlass; LockWindowUpdate(PageControl1.Handle); try FSelList.Clear; TStdBillsCtrl(FStdBillsCtrl).LoadNewStdLib(FLibNameList.Strings[cbFileName.ItemIndex]); FOpenLibName := cbFileName.Text; finally LockWindowUpdate(0); Screen.Cursor := crDefault; end; end; procedure TStdBillsLibFrm.LoadLibNames; var I: Integer; sFileName: string; begin FLibNameList := TStringList(ScConfigInfo.Strings); for I := 0 to FLibNameList.Count - 1 do begin sFileName := ChangeFileExt(ExtractFileName(FLibNameList[I]), ''); if (Pos('分项清单', sFileName) <> 0) or (Pos('项目清单', sFileName) <> 0) then cbFileName.Items.Add(sFileName) else if Pos('工程量清单', sFileName) <> 0 then begin cbbBillsQtyLibs.Items.Add(sFileName); FBillsQtyLibs.Add(FLibNameList[I]); FLibNameList.Delete(I); end; end; TStdBillsCtrl(FStdBillsCtrl).FXQDManager.ConfigFileManager.AddLibsTo(cbFileName.Items, FLibNameList, 1); end; procedure TStdBillsLibFrm.zgBillsLibMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin // Modified by GiLi 2012-4-18 11:21:58 // 标准项目表中双击编号时展开,双击名称列就添加到分段文件中。(取消右键添加) if (ssDouble in Shift) and (Button = mbLeft) then begin if not Assigned(FZjIDTree.Selected) then Exit; if zgBillsLib.CurCol = 0 then Exit; if (zgBillsLib.CurCol = 1) and FZjIDTree.Selected.HasChildren then begin FZjIDTree.Selected.Expanded := not FZjIDTree.Selected.Expanded; Exit; end else if (zgBillsLib.CurCol = 3) then {add Item operation} TStdBillsCtrl(FStdBillsCtrl).AddItem; end; end; procedure TStdBillsLibFrm.btnAddClick(Sender: TObject); var bShowProgressor: Boolean; begin // bShowProgressor := ShowProgressor; Screen.Cursor := crHourGlass; try if not TStdBillsCtrl(FStdBillsCtrl).AddItems(FSelList) then MessageError(Handle, '添加清单失败!!!'); finally // HideProgressor(bShowProgressor); Screen.Cursor := crDefault; end; end; procedure TStdBillsLibFrm.SetDQDataSet(const Value: TDataSet); begin zaDrawingQuantity.DataSet := Value; end; procedure TStdBillsLibFrm.SetZjIDTree(const Value: TZjIDTree); begin FZjIDTree := Value; zaBillsLib.IDTree := FZjIDTree; end; procedure TStdBillsLibFrm.BeginUpdateUI(aType: Integer); begin case aType of 1: zaBillsLib.DataSet.DisableControls; 2: zaBillsQty.DataSet.DisableControls; end; end; procedure TStdBillsLibFrm.EndUpdateUI(aType: Integer); begin case aType of 1: zaBillsLib.DataSet.EnableControls; 2: zaBillsQty.DataSet.EnableControls; end; end; procedure TStdBillsLibFrm.FormClose(Sender: TObject; var Action: TCloseAction); begin DisplayStdBillsLib; end; procedure TStdBillsLibFrm.SetIncStep(const Value: Integer); begin end; function TStdBillsLibFrm.GetCheckCount(aSelList: TIntegerSList): Integer; var I: Integer; begin Result := 0; for I := 0 to FZjIDTree.Count - 1 do begin if aSelList[I] <> 0 then Inc(Result); end; end; procedure TStdBillsLibFrm.HideProgressor(aShow: Boolean); begin end; function TStdBillsLibFrm.ShowProgressor: Boolean; var iCount: Integer; begin { iCount := GetCheckCount(FSelList); Result := iCount > 100; if Result then begin FProgressor.SetMax(iCount); FProgressor.Show; end; } end; procedure TStdBillsLibFrm.SetBillsQtyTree(const Value: TZjIDTree); begin FBillsQtyTree := Value; zaBillsQty.IDTree := FBillsQtyTree; end; procedure TStdBillsLibFrm.cbbBillsQtyLibsChange(Sender: TObject); begin Screen.Cursor := crHourGlass; LockWindowUpdate(PageControl1.Handle); try FBillsQtyList.Clear; TStdBillsCtrl(FStdBillsCtrl).LoadBillsQtyLib(FBillsQtyLibs.Strings[cbbBillsQtyLibs.ItemIndex]); finally LockWindowUpdate(0); Screen.Cursor := crDefault; end; end; procedure TStdBillsLibFrm.zaBillsQtyGridGetCellText(Sender: TObject; const ACoord: TPoint; var Value: String); var OldActiveRec: Integer; begin if (ACoord.X = 0) and zaBillsQty.ChangeActiveRecord(ACoord.Y - zgBillsQty.FixedRowCount, OldActiveRec) then begin try Value := ZjBooleanStr(FBillsQtyList[ACoord.Y - zgBillsQty.FixedRowCount] <> 0); finally zaBillsQty.ChangeActiveRecord(OldActiveRec, OldActiveRec); end; end; end; procedure TStdBillsLibFrm.zaBillsQtyGridSetCellText(Sender: TObject; const ACoord: TPoint; var Value: String); procedure SelectChildren(ANode: TZjIDTreeNode; ASelected: Boolean); var I: Integer; begin if ANode.HasChildren then for I := ANode.MajorIndex + 1 to ANode.LastPosterity.MajorIndex do FBillsQtyList[I] := Ord(ASelected); end; var OldActiveRec: Integer; ID: Integer; Node: TZjIDTreeNode; begin Node := FBillsQtyTree.Selected; if Assigned(Node) and (ACoord.X = 0) then begin ID := Node.ID; FBillsQtyList[Node.MajorIndex] := Ord(ZjStrToBoolean(Value)); SelectChildren(Node, ZjStrToBoolean(Value)); zgBillsQty.InvalidateCol(0); end; end; procedure TStdBillsLibFrm.zgBillsQtyMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if (ssDouble in Shift) and (Button = mbLeft) then begin if not Assigned(FBillsQtyTree.Selected) then Exit; if zgBillsQty.CurCol = 0 then Exit; if (zgBillsQty.CurCol <> 0) and FBillsQtyTree.Selected.HasChildren then begin FBillsQtyTree.Selected.Expanded := not FBillsQtyTree.Selected.Expanded; Exit; end; {add Item operation} TStdBillsCtrl(FStdBillsCtrl).AddBillsQtyItem; end; end; procedure TStdBillsLibFrm.btnAddQtyItemsClick(Sender: TObject); begin Screen.Cursor := crHourGlass; try if not TStdBillsCtrl(FStdBillsCtrl).AddBillsQtyItems(FBillsQtyList) then MessageError(Handle, '添加清单失败!!!'); finally Screen.Cursor := crDefault; end; end; procedure TStdBillsLibFrm.InitView; begin PageControl1.ActivePageIndex := 0; zgBillsLib.Height := Round((Screen.Height - 150) * 0.65); end; procedure TStdBillsLibFrm.ShowPage(aPage: Integer); begin JimPages1.ActivePageIndex := aPage; Self.Show; Application.ProcessMessages; if aPage = 1 then begin Screen.Cursor := crHourGlass; zgQtyItems.BeginUpdate; zaQtyItems.DataSet := nil; // zaQtyItems.DisableControl(True); try TStdBillsCtrl(FStdBillsCtrl).RefreshBills; finally zaQtyItems.DataSet := TStdBillsCtrl(FStdBillsCtrl).BillsLocateDM.cdsQBItems; // zaQtyItems.EnableControl; zgQtyItems.EndUpdate; Screen.Cursor := crDefault; end; end; end; function TStdBillsLibFrm.GetPageIdx: Integer; begin Result := JimPages1.ActivePageIndex; end; procedure TStdBillsLibFrm.SetQtyItemDataSet(const Value: TDataSet); begin zaQtyItems.DataSet := Value; end; procedure TStdBillsLibFrm.btnRefreshClick(Sender: TObject); begin Screen.Cursor := crHourGlass; zgQtyItems.BeginUpdate; // zaQtyItems.DisableControl(True); zaQtyItems.DataSet := nil; try TStdBillsCtrl(FStdBillsCtrl).RefreshBills; finally zaQtyItems.DataSet := TStdBillsCtrl(FStdBillsCtrl).BillsLocateDM.cdsQBItems; // zaQtyItems.EnableControl; zgQtyItems.EndUpdate; Screen.Cursor := crDefault; end; end; procedure TStdBillsLibFrm.btnLocateClick(Sender: TObject); begin TStdBillsCtrl(FStdBillsCtrl).LocateBills; end; procedure TStdBillsLibFrm.letBCodeChange(Sender: TObject); begin TStdBillsCtrl(FStdBillsCtrl).FindFirstBills(letBCode.Text); end; procedure TStdBillsLibFrm.zgQtyItemsMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if (Button = mbLeft) and (ssDouble in Shift) then TStdBillsCtrl(FStdBillsCtrl).LocateBills; end; procedure TStdBillsLibFrm.AddLib(const aShortName: string; aFileFlag: Integer); var sLibFile: string; begin sLibFile := TStdBillsCtrl(FStdBillsCtrl).FXQDManager.GenerateLibName(aShortName); if aFileFlag = 1 then begin cbFileName.Items.Add(aShortName); FLibNameList.Add(sLibFile); end else begin end; end; procedure TStdBillsLibFrm.DeleteLib(const aShortName: string; aFileFlag: Integer); var iIdx: Integer; sLibFile: string; begin sLibFile := TStdBillsCtrl(FStdBillsCtrl).FXQDManager.GenerateLibName(aShortName); if aFileFlag = 1 then begin iIdx := cbFileName.Items.IndexOf(aShortName); if iIdx > -1 then begin cbFileName.Items.Delete(iIdx); FLibNameList.Delete(iIdx); end; end else begin end; end; procedure TStdBillsLibFrm.ReNameLib(const aOldName, aNewName: string; aFileFlag: Integer); var iIdx: Integer; sLibFile: string; begin sLibFile := TStdBillsCtrl(FStdBillsCtrl).FXQDManager.GenerateLibName(aNewName); if aFileFlag = 1 then begin iIdx := cbFileName.Items.IndexOf(aOldName); if iIdx > -1 then begin cbFileName.Items[iIdx] := aNewName; FLibNameList[iIdx] := sLibFile; end; end else begin end; end; procedure TStdBillsLibFrm.btnCloseClick(Sender: TObject); begin Screen.Cursor := crHourGlass; try CloseLib(TButton(Sender).Tag); finally Screen.Cursor := crDefault; end; end; procedure TStdBillsLibFrm.CloseLib(aFileFlag: Integer); begin TStdBillsCtrl(FStdBillsCtrl).DMStdBillsLib.CloseLib(aFileFlag); if aFileFlag = 1 then begin cbFileName.ItemIndex := -1; FOpenLibName := ''; end else cbbBillsQtyLibs.ItemIndex := -1; end; procedure TStdBillsLibFrm.ldeFindByCodeChange(Sender: TObject); begin FFindIndex := 0; FindRecord(FFindIndex, ldeFindByCode.Text, ldeFindByName.Text); end; procedure TStdBillsLibFrm.FindRecord(var aIndex: Integer; const aCode, aName: string); begin if aIndex >= FZjIDTree.Count then Exit; TStdBillsCtrl(FStdBillsCtrl).DMStdBillsLib.FindRecord(FZjIDTree.Items[aIndex], aCode, aName); aIndex := FZjIDTree.SelectedIndex; end; procedure TStdBillsLibFrm.btnFindNextClick(Sender: TObject); begin Inc(FFindIndex); FindRecord(FFindIndex, ldeFindByCode.Text, ldeFindByName.Text); end; procedure TStdBillsLibFrm.zaBillsLibGridSetCellText(Sender: TObject; const ACoord: TPoint; var Value: String); procedure SelectChildren(ANode: TZjIDTreeNode; ASelected: Boolean); var I: Integer; begin if ANode.HasChildren then for I := ANode.MajorIndex + 1 to ANode.LastPosterity.MajorIndex do FSelList[I] := Ord(ASelected); end; var OldActiveRec: Integer; ID: Integer; Node: TZjIDTreeNode; begin Node := FZjIDTree.Selected; if Assigned(Node) and (ACoord.X = 0) then begin ID := Node.ID; FSelList[Node.MajorIndex] := Ord(ZjStrToBoolean(Value)); SelectChildren(Node, ZjStrToBoolean(Value)); zgBillsLib.InvalidateCol(0); end; end; procedure TStdBillsLibFrm.SetQtyDQDataSet(const Value: TDataSet); begin zaQtyDrawingItems.DataSet := Value; end; procedure TStdBillsLibFrm.DoOnGridCellCanDownLevel(Sender: TObject; const ACoord: TPoint; var Allow: Boolean); begin Allow := False; end; procedure TStdBillsLibFrm.DoOnGridCellCanUpLevel(Sender: TObject; const ACoord: TPoint; var Allow: Boolean); begin Allow := False; end; procedure TStdBillsLibFrm.ClearFilter; begin letBCode.Text := ''; end; // Added by GiLi 2012-3-19 11:35:41 // 右键菜单 添加当前项到清单 procedure TStdBillsLibFrm.N1Click(Sender: TObject); begin if not Assigned(FZjIDTree.Selected) then Exit; if zgBillsLib.CurCol = 0 then Exit; TStdBillsCtrl(FStdBillsCtrl).AddItem; end; // Added by GiLi 2012-3-19 12:07:50 // 展开 procedure TStdBillsLibFrm.N3Click(Sender: TObject); begin if not Assigned(FZjIDTree.Selected) then Exit; if zgBillsLib.CurCol = 0 then Exit; if (zgBillsLib.CurCol <> 0) and FZjIDTree.Selected.HasChildren then begin FZjIDTree.Selected.Expanded := True; end; end; // Added by GiLi 2012-3-19 12:07:57 // 关闭展开 procedure TStdBillsLibFrm.N4Click(Sender: TObject); begin if not Assigned(FZjIDTree.Selected) then Exit; if zgBillsLib.CurCol = 0 then Exit; if (zgBillsLib.CurCol <> 0) and FZjIDTree.Selected.HasChildren then begin FZjIDTree.Selected.Expanded := False; end; end; procedure TStdBillsLibFrm.btnViewToLevelsClick(Sender: TObject); var P: TPoint; begin P := ToolBar1.ClientToScreen( Point(btnViewToLevels.Left, btnViewToLevels.Top + btnViewToLevels.Height)); dxpmStdShowLevel.Popup(P.X, P.Y); end; procedure TStdBillsLibFrm.zgBillsLibCellGetColor(Sender: TObject; ACoord: TPoint; var AColor: TColor); begin if ACoord.Y = zgBillsLib.CurRow then AColor := $F0CAA6; end; end.