Measure/ProjGather/ProjGatherSelectFrm.pas

unit ProjGatherSelectFrm;

interface

uses
  sdIDTree, sdDB,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, sdGridDBA, sdGridTreeDBA, StdCtrls, ZJGrid, ZJCells;

type
  TProjGatherSelectForm = class(TForm)
    lblProjectList: TLabel;
    lblResult: TLabel;
    zgSelectProject: TZJGrid;
    zgResult: TZJGrid;
    btnOk: TButton;
    btnCancel: TButton;
    stdSelectProject: TsdGridTreeDBA;
    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 btnOkClick(Sender: TObject);
    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);
  private
    FProjectID: Integer;
    FValidProjs: TList;
    FSelectProjs: TList;
    FSpecialProjTypes: TStrings;
    FSpecialProjIDs: array of Integer;

    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);

    procedure LoadHistorySelects(AProjs: TList);

    procedure RefreshDiffWindows;
  public
    constructor Create(AProjectID: Integer; AProjs: TList; ASpecialProjTypes: TStrings);
    destructor Destroy; override;

    procedure AssignResult(AProjs: TList);
  end;

function SelectGatherProject(AProjectID: Integer; AOrgProjs, ANewProjs: TList; ASpecialProjTypes: TStrings = nil): Boolean;

implementation

uses
  Globals, GatherProjInfo, MainFrm, Math, ZhAPI;

{$R *.dfm}

function SelectGatherProject(AProjectID: Integer; AOrgProjs, ANewProjs: TList; ASpecialProjTypes: TStrings = nil): Boolean;
var
  vSelectFrm: TProjGatherSelectForm;
begin
  vSelectFrm := TProjGatherSelectForm.Create(AProjectID, AOrgProjs, ASpecialProjTypes);
  try
    Result := vSelectFrm.ShowModal = mrOk;
    if Result then
      vSelectFrm.AssignResult(ANewProjs);
  finally
    vSelectFrm.Free;
  end;
end;

{ TProjGatherSelectForm }

procedure TProjGatherSelectForm.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 TProjGatherSelectForm.AddValidProject(ANode: TsdIDTreeNode);
var
  iChild: Integer;
begin
  FValidProjs.Add(ANode);
  for iChild := 0 to ANode.ChildCount - 1 do
    AddValidProject(ANode.ChildNodes[iChild]);
end;

constructor TProjGatherSelectForm.Create(AProjectID: Integer;
  AProjs: TList; ASpecialProjTypes: TStrings);
var
  i: Integer;
begin
  inherited Create(nil);
  RefreshDiffWindows;
  FProjectID := AProjectID;
  FSpecialProjTypes := ASpecialProjTypes;
  if FSpecialProjTypes <> nil then
  begin
    SetLength(FSpecialProjIDs, FSpecialProjTypes.Count);
    for i := 0 to ASpecialProjTypes.Count - 1 do
      FSpecialProjIDs[i] := -1;
  end;

  FValidProjs := TList.Create;
  // È¡Ïû¹ýÂË
  //FilterValidProject;
  //ProjectManager.sdvProjectsSpare.OnFilterRecord := DoOnFilterRecord;
  ProjectManager.sdvProjectsSpare.Filtered := True;

  stdSelectProject.DataView := ProjectManager.sdvProjectsSpare;

  FSelectProjs := TList.Create;
  LoadHistorySelects(AProjs);
  AssignSelectTenders;
end;

destructor TProjGatherSelectForm.Destroy;
begin
  //ProjectManager.sdvProjectsSpare.Filtered := False;
  //ProjectManager.sdvProjectsSpare.OnFilterRecord := nil;
  FValidProjs.Free;
  FSelectProjs.Free;
  inherited;
end;

procedure TProjGatherSelectForm.DoOnFilterRecord(ARecord: TsdDataRecord;
  var AAllow: Boolean);
begin
  AAllow := Assigned(ARecord) and IsValidProj(ARecord.ValueByName('ID').AsInteger);
end;

procedure TProjGatherSelectForm.FilterValidProject;
var
  vTopParent: TsdIDTreeNode;
  i: Integer;
begin
  vTopParent := GetTopParent;
  AddValidProject(vTopParent);
end;

function TProjGatherSelectForm.GetTopParent: TsdIDTreeNode;
begin
  Result := ProjectManager.ProjectsTree.FindNode(FProjectID);
  while Assigned(Result.Parent) do
    Result := Result.Parent;
end;

function TProjGatherSelectForm.HasSelect(AProjectID: Integer): Boolean;
begin
  Result := FSelectProjs.IndexOf(Pointer(AProjectID)) <> -1;
end;

function TProjGatherSelectForm.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 TProjGatherSelectForm.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 TProjGatherSelectForm.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 TProjGatherSelectForm.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 TProjGatherSelectForm.zgSelectProjectCellTextChanged(
  Sender: TObject; Col, Row: Integer);
begin
  if (Col = 1) then
    AssignSelectTenders;
end;

procedure TProjGatherSelectForm.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;

procedure TProjGatherSelectForm.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;
end;

procedure TProjGatherSelectForm.btnOkClick(Sender: TObject);
begin
  if zgResult.RowCount > 1 then
    ModalResult := mrOk;
end;

procedure TProjGatherSelectForm.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;

procedure TProjGatherSelectForm.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 TProjGatherSelectForm.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 TProjGatherSelectForm.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 TProjGatherSelectForm.RefreshDiffWindows;
begin
  ClientHeight := 523;
  ClientWidth := 816;
end;

end.