unit BillsCompileFme; interface uses BillsCompileDm, UtilMethods, BillsClipboard, sdIDTree, BatchReplaceBillsFrm, CheckAndClearFrm, DealBillsFrm, BillsPasteSelectFrm, sdDB, BillsTree, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ActnList, sdGridDBA, sdGridTreeDBA, dxBar, ZJGrid, StdCtrls, ExtCtrls; type TBillsCompileFrame = class(TFrame) pnlExprs: TPanel; laEdtExprs: TLabeledEdit; pnlBills: TPanel; zgBillsCompile: TZJGrid; dxpmBillsCompile: TdxBarPopupMenu; stdBillsCompile: TsdGridTreeDBA; alBillsCompile: TActionList; actnCalculateLedger: TAction; actnCopyBillsBlock: TAction; actnExportGridToExcel: TAction; actnBatchAddChild: TAction; actnBatchAddNext: TAction; actnReorderChildrenCode: TAction; actnBatchReplaceBillsInfo: TAction; actnCheckAndClear: TAction; actnModifiedDealBills: TAction; actnSetBillsBookmark: TAction; actnImportGclBillsToXmj: TAction; actnImportPlaneFxBillsToXmj: TAction; procedure zgBillsCompileCopy(Sender: TObject; const ABounds: TRect; var Allow: Boolean); procedure zgBillsCompilePaste(Sender: TObject; const ABounds: TRect; var Allow: Boolean); procedure actnCopyBillsBlockExecute(Sender: TObject); procedure actnCalculateLedgerExecute(Sender: TObject); procedure dxpmBillsCompilePopup(Sender: TObject); procedure zgBillsCompileMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure zgBillsCompileCellGetColor(Sender: TObject; ACoord: TPoint; var AColor: TColor); procedure zgBillsCompileCellGetFont(Sender: TObject; ACoord: TPoint; AFont: TFont); procedure laEdtExprsExit(Sender: TObject); procedure laEdtExprsKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure actnBatchAddChildExecute(Sender: TObject); procedure actnBatchAddNextExecute(Sender: TObject); procedure actnBatchAddChildUpdate(Sender: TObject); procedure actnBatchAddNextUpdate(Sender: TObject); procedure actnReorderChildrenCodeExecute(Sender: TObject); procedure actnReorderChildrenCodeUpdate(Sender: TObject); procedure actnExportGridToExcelExecute(Sender: TObject); procedure actnBatchReplaceBillsInfoExecute(Sender: TObject); procedure actnBatchReplaceBillsInfoUpdate(Sender: TObject); procedure zgBillsCompileCustomPaste(Sender: TObject; ABounds: TRect; ASourSheet: TZjSheet); procedure zgBillsCompileKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure actnCheckAndClearExecute(Sender: TObject); procedure actnModifiedDealBillsExecute(Sender: TObject); procedure actnModifiedDealBillsUpdate(Sender: TObject); procedure actnSetBillsBookmarkExecute(Sender: TObject); procedure actnImportGclBillsToXmjUpdate(Sender: TObject); procedure actnImportGclBillsToXmjExecute(Sender: TObject); procedure actnImportPlaneFxBillsToXmjExecute(Sender: TObject); private FBillsCompileData: TBillsCompileData; FShowIDField: Boolean; FShowDesginQuantity: Boolean; FOnAfterSetBookmark: TBookmarkRefreshEvent; FShowAlias: Boolean; procedure CopyBillsBlock(ANode: TsdIDTreeNode; ABounds: TRect); procedure PasteBillsBlock(ANode: TsdIDTreeNode; ABounds: TRect); procedure SetShowIDField(AValue: Boolean); procedure BeginExpandNode; procedure EndExpandNode; procedure ResetBaseDataReadOnly(AReadOnly: Boolean); procedure ResetAllowInsert(AAllow: Boolean); function CheckExprsColumn: Boolean; procedure SetShowDesignQuantity(const Value: Boolean); procedure SetShowAlias(const Value: Boolean); public constructor Create(AParent: TFrame; ABillsCompileData: TBillsCompileData); destructor Destroy; override; procedure ExpandNodeTo(ALevel: Integer); procedure ExpandXmjNode; procedure ExpandPegXmjNode; procedure RefreshPhase_Stage; property ShowDesignQuantity: Boolean read FShowDesginQuantity write SetShowDesignQuantity; Property ShowAlias: Boolean read FShowAlias write SetShowAlias; property OnAfterSetBookmark: TBookmarkRefreshEvent read FOnAfterSetBookmark write FOnAfterSetBookmark; property BillsCompileData: TBillsCompileData read FBillsCompileData; end; implementation uses MainFrm, BatchInsertBillsFrm, ExportExcel, ProjectData, mEncryptEditions, ExcelImport, DetailExcelImport, mDataRecord; {$R *.dfm} { TBillsCompileFrame } procedure TBillsCompileFrame.CopyBillsBlock(ANode: TsdIDTreeNode; ABounds: TRect); var Clipboard: TBillsClipboard; begin Clipboard := TBillsClipboard.Create(FBillsCompileData.BillsData); try Clipboard.Copy(ANode, ABounds.Bottom - ABounds.Top); finally Clipboard.Free; end; end; procedure TBillsCompileFrame.PasteBillsBlock(ANode: TsdIDTreeNode; ABounds: TRect); var Clipboard: TBillsClipboard; iPos: Integer; begin if SelectBillsPasteType(iPos) then begin if iPos = -1 then Exit; Clipboard := TBillsClipboard.Create(FBillsCompileData.BillsData); try Clipboard.Paste(ANode, iPos); finally FBillsCompileData.CalculateAll; Clipboard.Free; end; end; end; procedure TBillsCompileFrame.zgBillsCompileCopy(Sender: TObject; const ABounds: TRect; var Allow: Boolean); var stnNode: TsdIDTreeNode; begin Allow := TZJGrid(Sender).Tag = 0; if not Allow then begin stnNode := stdBillsCompile.IDTree.Items[ABounds.Top - zgBillsCompile.FixedRowCount]; CopyBillsBlock(stnNode, ABounds); TZJGrid(Sender).Tag := 0; end; end; procedure TBillsCompileFrame.zgBillsCompilePaste(Sender: TObject; const ABounds: TRect; var Allow: Boolean); begin if HasBillsBlockFormat then begin Allow := False; PasteBillsBlock(stdBillsCompile.IDTree.Selected, ABounds); end; end; procedure TBillsCompileFrame.actnCopyBillsBlockExecute(Sender: TObject); begin if CheckCompileEdition then begin zgBillsCompile.Tag := 1; zgBillsCompile.CopyToClipboard(zgBillsCompile.Selection.Bounds); zgBillsCompile.Selection.SelectRow(zgBillsCompile.Selection.Top, zgBillsCompile.Selection.Bottom - 1); end; end; procedure TBillsCompileFrame.actnCalculateLedgerExecute(Sender: TObject); begin FBillsCompileData.CalculateAll; end; procedure TBillsCompileFrame.dxpmBillsCompilePopup(Sender: TObject); begin SetDxBtnAction(actnCalculateLedger, MainForm.dxbtnCalculateLedger); SetDxBtnAction(actnCopyBillsBlock, MainForm.dxbtnCopyBillsBlock); SetDxBtnAction(actnBatchAddChild, MainForm.dxbtnBatchAddChild); SetDxBtnAction(actnBatchAddNext, MainForm.dxbtnBatchAddNext); SetDxBtnAction(actnReorderChildrenCode, MainForm.dxbtnReorderChildrenCode); SetDxBtnAction(actnExportGridToExcel, MainForm.dxbtnExportGridToExcel); SetDxBtnAction(actnBatchReplaceBillsInfo, MainForm.dxbtnBatchReplaceBillsInfo); SetDxBtnAction(actnCheckAndClear, MainForm.dxbtnCheckAndClear); SetDxBtnAction(actnModifiedDealBills, MainForm.dxbtnModifyDealBills); SetDxBtnAction(actnSetBillsBookmark, MainForm.dxbtnSetBookmark); SetDxBtnAction(actnImportGclBillsToXmj, MainForm.dxbtnImportGclBillsToXmj); SetDxBtnAction(actnImportPlaneFxBillsToXmj, MainForm.dxbtnImportPlaneFxBillsToXmj); end; constructor TBillsCompileFrame.Create(AParent: TFrame; ABillsCompileData: TBillsCompileData); begin inherited Create(AParent); FBillsCompileData := ABillsCompileData; stdBillsCompile.IDTree := FBillsCompileData.BillsCompileTree; with TProjectData(FBillsCompileData.ProjectData) do stdBillsCompile.Column('LockedInfo').ReadOnly := ProjProperties.PhaseCount > 0; end; destructor TBillsCompileFrame.Destroy; begin inherited; end; procedure TBillsCompileFrame.zgBillsCompileMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button = mbRight then dxpmBillsCompile.PopupFromCursorPos else begin if CheckExprsColumn then laEdtExprs.Text := zgBillsCompile.CurCell.EditText else laEdtExprs.Text := ''; with stdBillsCompile.DataView do if Assigned(Current) then laEdtExprs.ReadOnly := Current.ValueByName('LockedInfo').AsBoolean; end; end; procedure TBillsCompileFrame.zgBillsCompileCellGetColor(Sender: TObject; ACoord: TPoint; var AColor: TColor); var stnNode: TBillsIDTreeNode; iCreatePhaseID: Integer; begin if ACoord.Y > stdBillsCompile.IDTree.Count + 2 then Exit; stnNode := TBillsIDTreeNode(stdBillsCompile.IDTree.Items[ACoord.Y - 3]); if not Assigned(stnNode) then Exit; iCreatePhaseID := stnNode.Rec.CreatePhaseID.AsInteger; if stnNode.ParentID = 1 then AColor := $00FBCAC4 else if (stnNode.Rec.B_Code.AsString = '') and (stnNode.Level > 0) then AColor := $00F9E8DF; // 书签 if stnNode.Rec.HasBookMark.AsBoolean then AColor := $00CFE2F9; // 根据节点创建期数底色不同 if iCreatePhaseID > 0 then begin // 当前期不存在节点,底色为灰色提示用户 if iCreatePhaseID > TProjectData(FBillsCompileData.ProjectData).PhaseIndex then AColor := $00D5D5D5 // 当前期新增节点,底色为黄色提示用户 else if iCreatePhaseID = TProjectData(FBillsCompileData.ProjectData).PhaseIndex then AColor := $00A7FDFD; end; end; procedure TBillsCompileFrame.zgBillsCompileCellGetFont(Sender: TObject; ACoord: TPoint; AFont: TFont); begin if ACoord.X = stdBillsCompile.VisibleCol('IsMeasureAdd') then AFont.Color := clInactiveCaptionText; end; procedure TBillsCompileFrame.laEdtExprsExit(Sender: TObject); begin if not TLabeledEdit(Sender).ReadOnly then if CheckExprsColumn then zgBillsCompile.CurCell.Text := laEdtExprs.Text; end; function TBillsCompileFrame.CheckExprsColumn: Boolean; var iCol: Integer; begin iCol := zgBillsCompile.CurCol-zgBillsCompile.FixedColCount; Result := (iCol = stdBillsCompile.VisibleCol('OrgQuantity')) or (iCol = stdBillsCompile.VisibleCol('MisQuantity')) or (iCol = stdBillsCompile.VisibleCol('OthQuantity')); end; procedure TBillsCompileFrame.laEdtExprsKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Key = VK_Return then begin zgBillsCompile.SetFocus; if not TLabeledEdit(Sender).ReadOnly then if CheckExprsColumn then zgBillsCompile.CurCell.Text := laEdtExprs.Text; end; end; procedure TBillsCompileFrame.actnBatchAddChildExecute(Sender: TObject); begin if CheckCompileEdition then AddLeafBills(FBillsCompileData, itChild); end; procedure TBillsCompileFrame.actnBatchAddNextExecute(Sender: TObject); begin if CheckCompileEdition then AddLeafBills(FBillsCompileData, itNextSibling); end; procedure TBillsCompileFrame.actnBatchAddChildUpdate(Sender: TObject); begin with stdBillsCompile.IDTree do TAction(Sender).Enabled := not Selected.HasChildren and (Selected.Rec.ValueByName('Code').AsString <> ''); end; procedure TBillsCompileFrame.actnBatchAddNextUpdate(Sender: TObject); function CheckLastXmj(ANode: TsdIDTreeNode): Boolean; var stnChild: TsdIDTreeNode; begin Result := ANode.Rec.ValueByName('Code').AsString <> ''; if not ANode.HasChildren then Exit; stnChild := ANode.FirstChild; while Result and Assigned(stnChild) do begin Result := Result and (stnChild.Rec.ValueByName('B_Code').AsString <> ''); stnChild := stnChild.NextSibling; end; end; begin with stdBillsCompile.IDTree do TAction(Sender).Enabled := Assigned(Selected) and CheckLastXmj(Selected); end; procedure TBillsCompileFrame.actnReorderChildrenCodeExecute( Sender: TObject); begin if CheckCompileEdition then if QuestMessage('是否将此节点的所有子项重新自动编号?') then FBillsCompileData.ReorderChildrenCode(stdBillsCompile.IDTree.Selected); end; procedure TBillsCompileFrame.actnReorderChildrenCodeUpdate( Sender: TObject); function WithoutGclChild(ANode: TsdIDTreeNode): Boolean; var stnChild: TsdIDTreeNode; begin Result := ANode.Rec.ValueByName('Code').AsString <> ''; if not ANode.HasChildren then Exit; stnChild := ANode.FirstChild; while Result and Assigned(stnChild) do begin Result := Result and (stnChild.Rec.ValueByName('B_Code').AsString = ''); stnChild := stnChild.NextSibling; end; end; begin with TProjectData(FBillsCompileData.ProjectData) do TAction(Sender).Enabled := ProjProperties.PhaseCount = 0; with stdBillsCompile.IDTree do TAction(Sender).Enabled := TAction(Sender).Enabled and Assigned(Selected) and WithoutGclChild(Selected); end; procedure TBillsCompileFrame.actnExportGridToExcelExecute(Sender: TObject); var sFileName: string; ExcelExportor: TExcelExportor; begin if SaveFile(sFileName, '.xls') then begin ExcelExportor := TExcelExportor.Create; try ExcelExportor.ExportToFile(zgBillsCompile, sFileName); finally ExcelExportor.Free; end; end; end; procedure TBillsCompileFrame.actnBatchReplaceBillsInfoExecute( Sender: TObject); begin if CheckCompileEdition then BatchReplaceBillsInfo(stdBillsCompile.DataView.Current, FBillsCompileData.BillsData); end; procedure TBillsCompileFrame.actnBatchReplaceBillsInfoUpdate( Sender: TObject); begin with TProjectData(FBillsCompileData.ProjectData) do TAction(Sender).Enabled := ProjProperties.PhaseCount = 0; TAction(Sender).Enabled := TAction(Sender).Enabled and Assigned(stdBillsCompile.IDTree.Selected) and (stdBillsCompile.IDTree.Selected.Rec.ValueByName('B_Code').AsString <> ''); end; procedure TBillsCompileFrame.zgBillsCompileCustomPaste(Sender: TObject; ABounds: TRect; ASourSheet: TZjSheet); var iRow, iCol: Integer; begin for iRow := ABounds.Top to ABounds.Bottom - 1 do begin if not zgBillsCompile.RowVisible[iRow] then Continue; for iCol := ABounds.Left to ABounds.Right - 1 do with TZJGrid(Sender).Cells[iCol, iRow] do if CanEdit then Text := ASourSheet.Values[iCol - ABounds.Left, iRow - ABounds.Top]; end; end; procedure TBillsCompileFrame.SetShowDesignQuantity(const Value: Boolean); begin FShowDesginQuantity := Value; stdBillsCompile.Column('DgnQuantity1').Visible := FShowDesginQuantity; stdBillsCompile.Column('DgnQuantity2').Visible := FShowDesginQuantity; stdBillsCompile.Column('DgnPrice').Visible := FShowDesginQuantity; end; procedure TBillsCompileFrame.zgBillsCompileKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin // For Inner Test if (ssCtrl in Shift) and (ssShift in Shift) and (ssAlt in Shift) and (Key in [73, 105]) // 'i', 'i' and (zgBillsCompile.CurCol = 1) then SetShowIDField(not FShowIDField); end; procedure TBillsCompileFrame.SetShowIDField(AValue: Boolean); begin FShowIDField := AValue; stdBillsCompile.Column('ID').Visible := AValue; stdBillsCompile.Column('ParentID').Visible := AValue; stdBillsCompile.Column('NextSiblingID').Visible := AValue; end; procedure TBillsCompileFrame.actnCheckAndClearExecute(Sender: TObject); begin ShowCheckAndClearForm(FBillsCompileData); end; procedure TBillsCompileFrame.actnModifiedDealBillsExecute(Sender: TObject); var DealBillsForm: TDealBillsForm; begin with TProjectData(FBillsCompileData.ProjectData) do DealBillsForm := TDealBillsForm.Create(DealBillsData); try DealBillsForm.ShowModal; finally DealBillsForm.Free; end; end; procedure TBillsCompileFrame.actnModifiedDealBillsUpdate(Sender: TObject); begin TAction(Sender).Enabled := TProjectData(FBillsCompileData.ProjectData).CanUnlockInfo; end; procedure TBillsCompileFrame.actnSetBillsBookmarkExecute(Sender: TObject); var Rec: TBillsRecord; begin Rec := TBillsRecord(stdBillsCompile.IDTree.Selected.Rec); if Rec.HasBookMark.AsBoolean then begin Rec.HasBookMark.AsBoolean := False; Rec.MarkMemo.AsString := ''; end else Rec.HasBookMark.AsBoolean := True; TProjectData(FBillsCompileData.ProjectData).BillsBookmarkData.RefreshBillsBookmark; if Assigned(FOnAfterSetBookmark) then FOnAfterSetBookmark(Rec.HasBookMark.AsBoolean); zgBillsCompile.InvalidateRow(zgBillsCompile.CurRow); end; procedure TBillsCompileFrame.SetShowAlias(const Value: Boolean); begin FShowAlias := Value; stdBillsCompile.Column('Alias').Visible := FShowAlias; end; procedure TBillsCompileFrame.actnImportGclBillsToXmjUpdate( Sender: TObject); begin with stdBillsCompile.IDTree do TAction(Sender).Enabled := not Selected.HasChildren and (Selected.Rec.ValueByName('Code').AsString <> ''); end; procedure TBillsCompileFrame.actnImportGclBillsToXmjExecute( Sender: TObject); var sFileName: string; Importor: TGclBillsExcelImport; begin if SelectFile(sFileName, '.xls') then begin Importor := TGclBillsExcelImport.Create(TProjectData(FBillsCompileData.ProjectData)); try Importor.ParentID := stdBillsCompile.IDTree.Selected.ID; Importor.ImportFile(sFileName); finally Importor.Free; end; end; end; procedure TBillsCompileFrame.ExpandNodeTo(ALevel: Integer); begin BeginExpandNode; try FBillsCompileData.ExpandNodeTo(ALevel); finally EndExpandNode; end; end; procedure TBillsCompileFrame.ExpandXmjNode; begin BeginExpandNode; try FBillsCompileData.ExpandXmjNode; finally EndExpandNode; end; end; procedure TBillsCompileFrame.BeginExpandNode; begin zgBillsCompile.OnCellGetColor := nil; BeginUpdateWindow(zgBillsCompile.Handle); stdBillsCompile.DisableControl; end; procedure TBillsCompileFrame.EndExpandNode; begin stdBillsCompile.EnableControl; EndUpdateWindow(zgBillsCompile.Handle); zgBillsCompile.OnCellGetColor := zgBillsCompileCellGetColor; zgBillsCompile.Invalidate; end; procedure TBillsCompileFrame.RefreshPhase_Stage; begin with TProjectData(FBillsCompileData.ProjectData) do begin ResetBaseDataReadOnly(BaseDataReadOnly); ResetAllowInsert(AllowInsert); end; end; procedure TBillsCompileFrame.ResetAllowInsert(AAllow: Boolean); begin if AAllow then stdBillsCompile.Options := stdBillsCompile.Options + [aoAllowInsert] else stdBillsCompile.Options := stdBillsCompile.Options - [aoAllowInsert]; end; procedure TBillsCompileFrame.ResetBaseDataReadOnly(AReadOnly: Boolean); begin stdBillsCompile.Column('Code').ReadOnly := AReadOnly; stdBillsCompile.Column('B_Code').ReadOnly := AReadOnly; stdBillsCompile.Column('Name').ReadOnly := AReadOnly; stdBillsCompile.Column('Units').ReadOnly := AReadOnly; stdBillsCompile.Column('Price').ReadOnly := AReadOnly; stdBillsCompile.Column('DrawingCode').ReadOnly := AReadOnly; end; procedure TBillsCompileFrame.actnImportPlaneFxBillsToXmjExecute( Sender: TObject); var sFileName: string; Importor: TPlaneFxBillsExcelImport; begin if SelectFile(sFileName, '.xls') then begin Importor := TPlaneFxBillsExcelImport.Create(TProjectData(FBillsCompileData.ProjectData)); try Importor.ParentID := stdBillsCompile.IDTree.Selected.ID; Importor.ImportFile(sFileName); finally Importor.Free; end; end; end; procedure TBillsCompileFrame.ExpandPegXmjNode; begin BeginExpandNode; try FBillsCompileData.ExpandPegXmjNode; finally EndExpandNode; end; end; end.