Measure/ProjGather/ProjGatherSelectFme.pas

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.