unit ProjGatherSelectFme; interface uses sdIDTree, sdDB, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, sdGridDBA, sdGridTreeDBA, ZJGrid, ZJCells; type TAfterSelectEvent = procedure of Object; TProjGatherSelectFrame = class(TFrame) zgSelectProject: TZJGrid; stdSelectProject: TsdGridTreeDBA; pnlProjects: TPanel; pnlProjectsTitle: TPanel; lblProjectList: TLabel; pnlProjLeft: TPanel; pnlProjRight: TPanel; pnlProjBottom: TPanel; pnlResults: TPanel; pnlResultTitle: TPanel; lblResult: TLabel; zgResult: TZJGrid; pnlResultLeft: TPanel; pnlResultBottom: TPanel; pnlResultRight: TPanel; procedure zgSelectProjectGetCellText(Sender: TObject; const ACoord: TPoint; var Value: String; DisplayText: Boolean); procedure zgSelectProjectSetCellText(Sender: TObject; const ACoord: TPoint; var Value: String; DisplayText: Boolean); procedure zgSelectProjectCellTextChanged(Sender: TObject; Col, Row: Integer); procedure zgSelectProjectDrawCellText(ACanvas: TCanvas; const ARect: TRect; const ACoord: TPoint; AGrid: TZJGrid; const Text: String; var ADefaultDraw: 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); procedure zgSelectProjectCellGetColor(Sender: TObject; ACoord: TPoint; var AColor: TColor); private FProjectID: Integer; FValidProjs: TList; FSelectProjs: TList; FSpecialProjTypes: TStrings; FSpecialProjIDs: array of Integer; FMarkedProjs: TList; FAfterSelectProject: TAfterSelectEvent; function HasSelect(AProjectID: Integer): Boolean; procedure AddProjs(ANode: TsdIDTreeNode); procedure RemoveProjs(ANode: TsdIDTreeNode); procedure AssignSelectTenders; function GetTopParent: TsdIDTreeNode; procedure AddValidProject(ANode: TsdIDTreeNode); procedure FilterValidProject; function IsValidProj(AID: Integer): Boolean; procedure DoOnFilterRecord(ARecord: TsdDataRecord; var AAllow: Boolean); public constructor Create(AProjectID: Integer; ASpecialProjTypes: TStrings); destructor Destroy; override; procedure LoadHistorySelects(AProjs: TList); procedure AssignResult(AProjs: TList); procedure ClearMarkedProj; function CheckProjPhaseValid(APhaseIndex: Integer): Boolean; property AfterSelectProject: TAfterSelectEvent read FAfterSelectProject write FAfterSelectProject; end; implementation uses Globals, GatherProjInfo, MainFrm, Math, ZhAPI; {$R *.dfm} { TProjGatherSelectFrame } procedure TProjGatherSelectFrame.AddProjs(ANode: TsdIDTreeNode); var iChild: Integer; begin if FSelectProjs.IndexOf(Pointer(ANode.ID)) = -1 then FSelectProjs.Add(Pointer(ANode.id)); for iChild := 0 to ANode.ChildCount - 1 do AddProjs(ANode.ChildNodes[iChild]); end; procedure TProjGatherSelectFrame.AddValidProject(ANode: TsdIDTreeNode); var iChild: Integer; begin FValidProjs.Add(ANode); for iChild := 0 to ANode.ChildCount - 1 do AddValidProject(ANode.ChildNodes[iChild]); end; procedure TProjGatherSelectFrame.AssignSelectTenders; procedure InitResultGrid; var i: Integer; begin zgResult.ColCount := 2; zgResult.RowCount := 1; zgResult.Cells[1, 0].Text := '所选项目'; zgResult.ColWidths[1] := 308; if Assigned(FSpecialProjTypes) then begin zgResult.ColWidths[1] := 308 - (Min(FSpecialProjTypes.Count, 2)*45); for i := 0 to FSpecialProjTypes.Count - 1 do begin zgResult.ColCount := zgResult.ColCount + 1; zgResult.Cells[2+i, 0].Text := FSpecialProjTypes.Strings[i]; zgResult.ColWidths[2+i] := 45; zgResult.CellClass.Cols[2+i] := TZjCheckBoxCell; end; end; end; var stnNode: TsdIDTreeNode; i, iProjectID: Integer; begin InitResultGrid; for i := 0 to FSelectProjs.Count - 1 do begin iProjectID := Integer(FSelectProjs.Items[i]); stnNode := stdSelectProject.IDTree.FindNode(iProjectID); if stnNode.Rec.ValueByName('Type').AsInteger = 1 then begin zgResult.RowCount := zgResult.RowCount + 1; 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 := stnNode; end; end; end; constructor TProjGatherSelectFrame.Create(AProjectID: Integer; ASpecialProjTypes: TStrings); var i: Integer; begin inherited Create(nil); FMarkedProjs := TList.Create; FSelectProjs := TList.Create; FProjectID := AProjectID; FValidProjs := TList.Create; // 取消过滤 //FilterValidProject; //ProjectManager.sdvProjectsSpare.OnFilterRecord := DoOnFilterRecord; ProjectManager.sdvProjectsSpare.Filtered := True; stdSelectProject.DataView := ProjectManager.sdvProjectsSpare; FSpecialProjTypes := ASpecialProjTypes; if FSpecialProjTypes <> nil then begin SetLength(FSpecialProjIDs, FSpecialProjTypes.Count); for i := 0 to ASpecialProjTypes.Count - 1 do FSpecialProjIDs[i] := -1; end; end; destructor TProjGatherSelectFrame.Destroy; begin //ProjectManager.sdvProjectsSpare.Filtered := False; //ProjectManager.sdvProjectsSpare.OnFilterRecord := nil; FValidProjs.Free; FSelectProjs.Free; FMarkedProjs.Free; inherited; end; procedure TProjGatherSelectFrame.DoOnFilterRecord(ARecord: TsdDataRecord; var AAllow: Boolean); begin AAllow := Assigned(ARecord) and IsValidProj(ARecord.ValueByName('ID').AsInteger); end; procedure TProjGatherSelectFrame.FilterValidProject; var vTopParent: TsdIDTreeNode; i: Integer; begin vTopParent := GetTopParent; AddValidProject(vTopParent); end; function TProjGatherSelectFrame.GetTopParent: TsdIDTreeNode; begin Result := ProjectManager.ProjectsTree.FindNode(FProjectID); while Assigned(Result.Parent) do Result := Result.Parent; end; function TProjGatherSelectFrame.HasSelect(AProjectID: Integer): Boolean; begin Result := FSelectProjs.IndexOf(Pointer(AProjectID)) <> -1; end; function TProjGatherSelectFrame.IsValidProj(AID: Integer): Boolean; var i: Integer; vNode: TsdIDTreeNode; begin Result := False; for i := 0 to FValidProjs.Count - 1 do begin vNode := TsdIDTreeNode(FValidProjs.Items[i]); if vNode.ID = AID then begin Result := True; Break; end; end; end; procedure TProjGatherSelectFrame.LoadHistorySelects(AProjs: TList); var i: Integer; vGatherProjInfo: TGatherProjInfo; begin for i := 0 to AProjs.Count - 1 do begin vGatherProjInfo := TGatherProjInfo(AProjs.Items[i]); FSelectProjs.Add(Pointer(vGatherProjInfo.ProjectID)); if Assigned(FSpecialProjTypes) then begin if (vGatherProjInfo.ProjType > 0) and (vGatherProjInfo.ProjType <= FSpecialProjTypes.Count) then FSpecialProjIDs[vGatherProjInfo.ProjType-1] := vGatherProjInfo.ProjectID; end; end; AssignSelectTenders; end; procedure TProjGatherSelectFrame.RemoveProjs(ANode: TsdIDTreeNode); var iChild: Integer; i: Integer; begin if FSelectProjs.IndexOf(Pointer(ANode.ID)) <> -1 then begin FSelectProjs.Remove(Pointer(ANode.id)); for i := Low(FSpecialProjIDs) to High(FSpecialProjIDs) do if FSpecialProjIDs[i] = ANode.ID then FSpecialProjIDs[i] := -1; end; for iChild := 0 to ANode.ChildCount - 1 do RemoveProjs(ANode.ChildNodes[iChild]); end; procedure TProjGatherSelectFrame.zgSelectProjectGetCellText( 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 Assigned(stnNode) and HasSelect(stnNode.ID) then Value := 'True'; end; end; procedure TProjGatherSelectFrame.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 AddProjs(stnNode) else RemoveProjs(stnNode); end; zgSelectProject.InvalidateCol(1); end; procedure TProjGatherSelectFrame.zgSelectProjectCellTextChanged( Sender: TObject; Col, Row: Integer); begin if (Col = 1) then begin AssignSelectTenders; if Assigned(FAfterSelectProject) then FAfterSelectProject; end; end; procedure TProjGatherSelectFrame.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 TProjGatherSelectFrame.zgResultGetCellText(Sender: TObject; const ACoord: TPoint; var Value: String; DisplayText: Boolean); begin if (ACoord.X > 1) and (ACoord.Y > 0) then begin if Assigned(zgResult.Rows[ACoord.Y].Data) and (TsdIDTreeNode(zgResult.Rows[ACoord.Y].Data).ID = FSpecialProjIDs[ACoord.X-2]) then Value := 'True' else Value := 'False'; end; end; procedure TProjGatherSelectFrame.zgResultSetCellText(Sender: TObject; const ACoord: TPoint; var Value: String; DisplayText: Boolean); var iProjID, i: Integer; stnNode: TsdIDTreeNode; begin if (ACoord.X > 1) and (ACoord.Y > 0) then begin stnNode := TsdIDTreeNode(zgResult.Rows[ACoord.Y].Data); iProjID := stnNode.ID; if FSpecialProjIDs[ACoord.X-2] <> iProjID then begin for i := Low(FSpecialProjIDs) to High(FSpecialProjIDs) do begin if FSpecialProjIDs[i] = iProjID then FSpecialProjIDs[i] := -1 end; FSpecialProjIDs[ACoord.X-2] := iProjID; end else FSpecialProjIDs[ACoord.X-2] := -1; for i := 0 to FSpecialProjTypes.Count - 1 do zgResult.InvalidateCol(i+2); end; end; procedure TProjGatherSelectFrame.AssignResult(AProjs: TList); function SpecialProjType(AID: Integer): Integer; var i: Integer; begin Result := 0; for i := Low(FSpecialProjIDs) to High(FSpecialProjIDs) do begin if AID = FSpecialProjIDs[i] then begin Result := i+1; Break; end; end; end; var iRow: Integer; stnNode: TsdIDTreeNode; vGatherProj: TGatherProjInfo; begin AProjs.Clear; for iRow := 1 to zgResult.RowCount - 1 do begin stnNode := TsdIDTreeNode(zgResult.Rows[iRow].Data); vGatherProj := TGatherProjInfo.Create(stnNode, -1, SpecialProjType(stnNode.ID)); AProjs.Add(vGatherProj); end; end; function TProjGatherSelectFrame.CheckProjPhaseValid( APhaseIndex: Integer): Boolean; var iRow: Integer; stnNode: TsdIDTreeNode; begin FMarkedProjs.Clear; for iRow := 1 to zgResult.RowCount - 1 do begin stnNode := TsdIDTreeNode(zgResult.Rows[iRow].Data); if stnNode.Rec.ValueByName('PhaseCount').AsInteger < APhaseIndex then FMarkedProjs.Add(Pointer(stnNode.ID)); end; Result := FMarkedProjs.Count = 0; zgSelectProject.Invalidate; end; procedure TProjGatherSelectFrame.zgSelectProjectCellGetColor( Sender: TObject; ACoord: TPoint; var AColor: TColor); var vProj: TsdIDTreeNode; begin if ACoord.Y > 0 then begin vProj := stdSelectProject.IDTree.Items[ACoord.Y - 1]; if Assigned(vProj) then begin if FMarkedProjs.IndexOf(Pointer(vProj.ID)) <> -1 then AColor := $00646AFE else AColor := clWindow; end; end; end; procedure TProjGatherSelectFrame.ClearMarkedProj; begin FMarkedProjs.Clear; zgSelectProject.Invalidate; end; end.