unit rmSelectProjectFrm; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, sdGridDBA, sdGridTreeDBA, sdIDTree, ZJGrid; type // 初步设计 Preliminary Design // 施工图设计 Construction Drawing Design // 批准概算 Approved Budget // 多合同 Deal // 甘肃高管局定制 Mental1 TMultiSelectType = (mstCommon, mstE_PCD, mstE_A, mstDeal, mstMental1); // 所选项目 TSelectProject = class private FProjectID: Integer; FIsTender: Boolean; FIsPD: Boolean; FIsCDD: Boolean; FIsAB: Boolean; FIsDeal: Boolean; public property ProjectID: Integer read FProjectID write FProjectID; property IsTender: Boolean read FIsTender write FIsTender; // 初步设计(概算)项目 property IsPD: Boolean read FIsPD write FIsPD; // 施工图设计(预算)项目 property IsCDD: Boolean read FIsCDD write FIsCDD; // 批准概算项目 property IsAB: Boolean read FIsAB write FIsAB; // 多合同项目(二三部分,土地征拆、监理等) property IsDeal: Boolean read FIsDeal write FIsDeal; end; TProjectSelectForm = class(TForm) zgSelectProject: TZJGrid; stdSelectProject: TsdGridTreeDBA; btnOk: TButton; btnCancel: TButton; lblProjectList: TLabel; lblResult: TLabel; zgResult: TZJGrid; procedure zgSelectProjectCellTextChanged(Sender: TObject; Col, Row: Integer); procedure btnOkClick(Sender: TObject); procedure zgSelectProjectDrawCellText(ACanvas: TCanvas; const ARect: TRect; const ACoord: TPoint; AGrid: TZJGrid; const Text: String; var ADefaultDraw: Boolean); procedure zgSelectProjectCellTextChanging(Sender: TObject; const ACoord: TPoint; var NewValue: String; var Accept: Boolean); procedure zgSelectProjectSetCellText(Sender: TObject; const ACoord: TPoint; var Value: String; DisplayText: Boolean); procedure zgSelectProjectGetCellText(Sender: TObject; const ACoord: TPoint; var Value: String; DisplayText: Boolean); procedure zgResultGetCellText(Sender: TObject; const ACoord: TPoint; var Value: String; DisplayText: Boolean); procedure zgResultSetCellText(Sender: TObject; const ACoord: TPoint; var Value: String; DisplayText: Boolean); private FMultiSelect: Boolean; FMultiSelectType: TMultiSelectType; // 记录可选项目列表的勾选情况 FSelectProjects: TList; FOnAssignResult: Boolean; procedure AssignResult; function FindSelectProject(AProjectID: Integer): TSelectProject; function CreateSelectProject(ANode: TsdIDTreeNode): TSelectProject; procedure AddRows(ANode: TsdIDTreeNode); procedure RemoveRows(ANode: TsdIDTreeNode); procedure SetPDProject(AProjecID: Integer); procedure SetCDDProject(AProjectID: Integer); procedure SetABProject(AProjectID: Integer); function HasPDProject: Boolean; function HasCDDProject: Boolean; function HasABProject: Boolean; procedure InitForm; procedure InitResultGrid; procedure SetMultiSelectType(const Value: TMultiSelectType); public constructor Create(AMultiSelect: Boolean; AProjectID: Integer; AProjects: TList); destructor Destroy; override; procedure SelectResult(var AProjectID: Integer); overload; procedure SelectResult(AProjects: TList); overload; // 可选多个 property MultiSelect: Boolean read FMultiSelect; property MultiSelectType: TMultiSelectType read FMultiSelectType write SetMultiSelectType; end; implementation uses Globals, MainFrm, ZhAPI, ZjCells; {$R *.dfm} { TProjectSelectForm } procedure TProjectSelectForm.AssignResult; var iRow: Integer; stnNode: TsdIDTreeNode; i: Integer; SelectProject: TSelectProject; begin FOnAssignResult := True; zgSelectProject.Invalidate; InitResultGrid; for i := 0 to FSelectProjects.Count - 1 do begin SelectProject := TSelectProject(FSelectProjects.Items[i]); if SelectProject.IsTender then begin zgResult.RowCount := zgResult.RowCount + 1; stnNode := stdSelectProject.IDTree.FindNode(SelectProject.ProjectID); zgResult.Cells[1, zgResult.RowCount - 1].Text := stnNode.Rec.ValueByName('Name').AsString; zgResult.Cells[1, zgResult.RowCount - 1].Align := gaCenterLeft; zgResult.Rows[zgResult.RowCount - 1].Data := SelectProject; case FMultiSelectType of mstE_PCD: begin if SelectProject.IsPD then zgResult.Cells[2, zgResult.RowCount - 1].Text := 'True'; if SelectProject.IsCDD then zgResult.Cells[3, zgResult.RowCount - 1].Text := 'True'; end; mstE_A: begin if SelectProject.IsAB then zgResult.Cells[2, zgResult.RowCount - 1].Text := 'True'; end; mstDeal: begin if SelectProject.IsDeal then zgResult.Cells[2, zgResult.RowCount - 1].Text := 'True'; end; end; end; end; FOnAssignResult := False; end; procedure TProjectSelectForm.SelectResult(var AProjectID: Integer); var SelectProject: TSelectProject; begin AProjectID := -1; if FSelectProjects.Count > 0 then begin SelectProject := TSelectProject(FSelectProjects[0]); AProjectID := SelectProject.ProjectID; end; end; procedure TProjectSelectForm.zgSelectProjectCellTextChanged( Sender: TObject; Col, Row: Integer); begin if (Col = 1) then AssignResult; end; procedure TProjectSelectForm.btnOkClick(Sender: TObject); var iLimitProjectCount: Integer; begin iLimitProjectCount := 1; if FMultiSelect then begin if FMultiSelectType = mstE_PCD then iLimitProjectCount := 3 else if FMultiSelectType = mstE_A then iLimitProjectCount := 2 else iLimitProjectCount := 2; end; if (zgResult.RowCount > iLimitProjectCount) then begin if FMultiSelect then begin if (FMultiSelectType = mstE_PCD) and HasPDProject and HasCDDProject then ModalResult := mrOk else if (FMultiSelectType = mstE_A) and HasABProject then ModalResult := mrOk else if FMultiSelectType in [mstCommon, mstDeal, mstMental1] then ModalResult := mrOk; end else ModalResult := mrOK; end; end; constructor TProjectSelectForm.Create(AMultiSelect: Boolean; AProjectID: Integer; AProjects: TList); var stnNode: TsdIDTreeNode; begin inherited Create(nil); FMultiSelect := AMultiSelect; stdSelectProject.IDTree := ProjectManager.ProjectsTree; FSelectProjects := TList.Create; if not AMultiSelect then begin stnNode := stdSelectProject.IDTree.FindNode(AProjectID); AddRows(stnNode); end else FSelectProjects.Assign(AProjects); InitForm; AssignResult; end; procedure TProjectSelectForm.zgSelectProjectDrawCellText(ACanvas: TCanvas; const ARect: TRect; const ACoord: TPoint; AGrid: TZJGrid; const Text: String; var ADefaultDraw: Boolean); procedure GetBitmap(AImage: TBitmap); begin with stdSelectProject.IDTree.Items[ACoord.Y - 1] do if Rec.ValueByName('Type').AsInteger = 0 then if Expanded and HasChildren then MainForm.Images.GetBitmap(34, AImage) else MainForm.Images.GetBitmap(34, AImage) else MainForm.Images.GetBitmap(11, AImage); end; const rIconWidth = 16; rIconHeight = 16; var Img: TBitmap; Cell: TZjCell; rImg: TRect; begin if (ACoord.X = 2) and (ACoord.Y > zgSelectProject.FixedRowCount - 1) then begin Cell := zgSelectProject.Cells[ACoord.X, ACoord.Y]; Img := TBitmap.Create; try GetBitmap(Img); case Cell.Align of gaTopLeft, gaTopCenter, gaTopRight: rImg := Rect(ARect.Left + 2, ARect.Top, ARect.Left + rIconWidth, ARect.Top + rIconHeight); gaCenterLeft, gaCenterCenter, gaCenterRight: rImg := Rect(ARect.Left + 2, ARect.Top + (ARect.Bottom - ARect.Top - rIconHeight) div 2, ARect.Left + rIconWidth, ARect.Bottom - (ARect.Bottom - ARect.Top - rIconHeight) div 2); gaBottomLeft, gaBottomCenter, gaBottomRight: rImg := Rect(ARect.Left + 2, ARect.Bottom - rIconHeight, ARect.Left + rIconWidth, ARect.Bottom); end; ACanvas.StretchDraw(rImg, Img); WriteText(ACanvas, Rect(ARect.Left + rIconWidth, ARect.Top, ARect.Right, ARect.Bottom) , 2, 2, Text, Cell.Align, False); ADefaultDraw := False; finally Img.Free; end; end; end; procedure TProjectSelectForm.zgSelectProjectCellTextChanging( Sender: TObject; const ACoord: TPoint; var NewValue: String; var Accept: Boolean); var stnNode: TsdIDTreeNode; begin if (ACoord.X = 1) then begin stnNode := stdSelectProject.IDTree.Items[ACoord.Y - 1]; if not FMultiSelect then begin Accept := stnNode.Rec.ValueByName('Type').AsInteger = 1; if Accept then begin ClearObjects(FSelectProjects); FSelectProjects.Clear; end; end; end; end; procedure TProjectSelectForm.zgSelectProjectSetCellText(Sender: TObject; const ACoord: TPoint; var Value: String; DisplayText: Boolean); var stnNode: TsdIDTreeNode; begin if ACoord.X = 1 then begin stnNode := stdSelectProject.IDTree.Items[ACoord.Y - 1]; if Value = 'True' then AddRows(stnNode) else RemoveRows(stnNode); end; end; procedure TProjectSelectForm.zgSelectProjectGetCellText(Sender: TObject; const ACoord: TPoint; var Value: String; DisplayText: Boolean); var stnNode: TsdIDTreeNode; SelectProject: TSelectProject; begin if ACoord.X = 1 then begin stnNode := stdSelectProject.IDTree.Items[ACoord.Y - 1]; if Assigned(stnNode) then begin SelectProject := FindSelectProject(stnNode.ID); if Assigned(SelectProject) then Value := 'True'; end; end; end; destructor TProjectSelectForm.Destroy; begin FSelectProjects.Free; inherited; end; procedure TProjectSelectForm.AddRows(ANode: TsdIDTreeNode); var iChild: Integer; SelectProject: TSelectProject; begin if not Assigned(ANode) then Exit; SelectProject := FindSelectProject(ANode.ID); if not Assigned(SelectProject) then CreateSelectProject(ANode); if ANode.HasChildren then for iChild := 0 to ANode.ChildCount - 1 do AddRows(ANode.ChildNodes[iChild]); end; procedure TProjectSelectForm.RemoveRows(ANode: TsdIDTreeNode); var iChild: Integer; SelectProject: TSelectProject; begin if not Assigned(ANode) then Exit; SelectProject := FindSelectProject(ANode.ID); if Assigned(SelectProject) then begin FSelectProjects.Remove(SelectProject); SelectProject.Free; end; if ANode.HasChildren then for iChild := 0 to ANode.ChildCount - 1 do RemoveRows(ANode.ChildNodes[iChild]); end; procedure TProjectSelectForm.SelectResult(AProjects: TList); begin AProjects.Assign(FSelectProjects); end; procedure TProjectSelectForm.InitResultGrid; procedure InitCommonResultGrid; begin zgResult.ColCount := 2; zgResult.RowCount := 1; zgResult.Cells[1, 0].Text := '所选项目'; zgResult.ColWidths[1] := 270; end; procedure InitE_PCDResultGrid; begin zgResult.ColCount := 4; zgResult.RowCount := 1; zgResult.Cells[1, 0].Text := '所选项目'; zgResult.ColWidths[1] := 200; zgResult.Cells[2, 0].Text := '初步设计概算'; zgResult.CellClass.Cols[2] := TZjCheckBoxCell; zgResult.ColWidths[2] := 47; zgResult.Cells[3, 0].Text := '施工图设计预算'; zgResult.CellClass.Cols[3] := TZjCheckBoxCell; zgResult.ColWidths[3] := 55; end; procedure InitE_AResultGrid; begin zgResult.ColCount := 3; zgResult.RowCount := 1; zgResult.Cells[1, 0].Text := '所选项目'; zgResult.ColWidths[1] := 230; zgResult.Cells[2, 0].Text := '批准概(预)算'; zgResult.CellClass.Cols[2] := TZjCheckBoxCell; zgResult.ColWidths[2] := 42; end; procedure InitDealResultGrid; begin zgResult.ColCount := 3; zgResult.RowCount := 1; zgResult.Cells[1, 0].Text := '所选项目'; zgResult.ColWidths[1] := 230; zgResult.Cells[2, 0].Text := '多合同项目'; zgResult.CellClass.Cols[2] := TZjCheckBoxCell; zgResult.ColWidths[2] := 42; end; begin case FMultiSelectType of mstCommon: InitCommonResultGrid; mstE_PCD: InitE_PCDResultGrid; mstE_A: InitE_AResultGrid; mstDeal: InitDealResultGrid; end; end; procedure TProjectSelectForm.zgResultGetCellText(Sender: TObject; const ACoord: TPoint; var Value: String; DisplayText: Boolean); var SelectProject: TSelectProject; begin if (ACoord.Y > 0) and (ACoord.X > 1) then begin SelectProject := TSelectProject(zgResult.Rows[ACoord.Y].Data); if not Assigned(SelectProject) then Exit; case FMultiSelectType of mstE_PCD: if ((ACoord.X = 2) and SelectProject.IsPD) or ((ACoord.X = 3) and SelectProject.IsCDD) then Value := 'True' else Value := 'False'; mstE_A: if SelectProject.IsAB then Value := 'True' else Value := 'False'; mstDeal: if SelectProject.IsDeal then Value := 'True' else Value := 'False'; end; end; end; procedure TProjectSelectForm.zgResultSetCellText(Sender: TObject; const ACoord: TPoint; var Value: String; DisplayText: Boolean); var SelectProject: TSelectProject; begin if not FOnAssignResult and (ACoord.X > 1) and (ACoord.Y > 0) then begin SelectProject := TSelectProject(zgResult.Rows[ACoord.Y].Data); if Value = 'True' then case FMultiSelectType of mstE_PCD: if ACoord.X = 2 then SetPDProject(SelectProject.ProjectID) else if ACoord.X = 3 then SetCDDProject(SelectProject.ProjectID); mstE_A: SetABProject(SelectProject.ProjectID); mstDeal: SelectProject.IsDeal := True; end else case FMultiSelectType of mstE_PCD: if ACoord.X = 2 then SelectProject.IsPD := False else SelectProject.IsCDD := False; mstE_A: SelectProject.IsAB := False; mstDeal: SelectProject.IsDeal := False; end; end; zgResult.InvalidateCol(ACoord.X); zgResult.InvalidateRow(ACoord.Y); end; procedure TProjectSelectForm.InitForm; var iWidth: Integer; begin if not FMultiSelect then Caption := '请选择原报项目' else Caption := '请选择汇总项目'; case FMultiSelectType of mstE_PCD: Caption := Caption + ',并勾选初步设计、施工图设计项目'; mstE_A: Caption := Caption + ',并勾选批准概(预)算项目'; mstDeal: Caption := Caption + ',并勾选其中的多合同项目'; end; // 甘肃高管局定制,隐藏结果表 iWidth := GetSystemMetrics(SM_CXFRAME); if FMultiSelectType = mstMental1 then ClientWidth := 384 else ClientWidth := 729; end; procedure TProjectSelectForm.SetMultiSelectType( const Value: TMultiSelectType); begin FMultiSelectType := Value; InitForm; AssignResult; end; function TProjectSelectForm.FindSelectProject( AProjectID: Integer): TSelectProject; var i: Integer; SelectProject: TSelectProject; begin Result := nil; for i := 0 to FSelectProjects.Count - 1 do begin SelectProject := TSelectProject(FSelectProjects.Items[i]); if SelectProject.FProjectID = AProjectID then begin Result := SelectProject; Break; end; end; end; function TProjectSelectForm.CreateSelectProject( ANode: TsdIDTreeNode): TSelectProject; begin Result := TSelectProject.Create; FSelectProjects.Add(Result); Result.ProjectID := ANode.ID; Result.FIsTender := ANode.Rec.ValueByName('Type').AsInteger = 1; Result.FIsPD := False; Result.FIsCDD := False; Result.FIsAB := False; Result.FIsDeal := False; end; procedure TProjectSelectForm.SetPDProject(AProjecID: Integer); var i: Integer; SelectProject: TSelectProject; begin for i := 0 to FSelectProjects.Count - 1 do begin SelectProject := TSelectProject(FSelectProjects.Items[i]); SelectProject.IsPD := SelectProject.ProjectID = AProjecID; if SelectProject.IsPD and SelectProject.IsCDD then SelectProject.IsCDD := False; end; end; procedure TProjectSelectForm.SetABProject(AProjectID: Integer); var i: Integer; SelectProject: TSelectProject; begin for i := 0 to FSelectProjects.Count - 1 do begin SelectProject := TSelectProject(FSelectProjects.Items[i]); SelectProject.IsAB := SelectProject.ProjectID = AProjectID; end; end; procedure TProjectSelectForm.SetCDDProject(AProjectID: Integer); var i: Integer; SelectProject: TSelectProject; begin for i := 0 to FSelectProjects.Count - 1 do begin SelectProject := TSelectProject(FSelectProjects.Items[i]); SelectProject.IsCDD := SelectProject.ProjectID = AProjectID; if SelectProject.IsCDD and SelectProject.IsPD then SelectProject.IsPD := False; end; end; function TProjectSelectForm.HasABProject: Boolean; var i: Integer; SelectProject: TSelectProject; begin Result := False; for i := 0 to FSelectProjects.Count - 1 do begin SelectProject := TSelectProject(FSelectProjects.Items[i]); if SelectProject.IsAB then begin Result := True; Break; end; end; end; function TProjectSelectForm.HasCDDProject: Boolean; var i: Integer; SelectProject: TSelectProject; begin Result := False; for i := 0 to FSelectProjects.Count - 1 do begin SelectProject := TSelectProject(FSelectProjects.Items[i]); if SelectProject.IsCDD then begin Result := True; Break; end; end; end; function TProjectSelectForm.HasPDProject: Boolean; var i: Integer; SelectProject: TSelectProject; begin Result := False; for i := 0 to FSelectProjects.Count - 1 do begin SelectProject := TSelectProject(FSelectProjects.Items[i]); if SelectProject.IsPD then begin Result := True; Break; end; end; end; end.