123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321 |
- unit ProjGatherSelectFrm;
- interface
- uses
- sdIDTree, sdDB,
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, sdGridDBA, sdGridTreeDBA, StdCtrls, ZJGrid;
- 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);
- private
- FProjectID: Integer;
- FValidProjs: TList;
- FSelectProjs: TList;
- 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);
- public
- constructor Create(AProjectID: Integer; AProjs: TList);
- destructor Destroy; override;
- procedure AssignResult(AProjs: TList);
- end;
- function SelectGatherProject(AProjectID: Integer; AOrgProjs, ANewProjs: TList): Boolean;
- implementation
- uses
- Globals, GatherProjInfo, MainFrm;
- {$R *.dfm}
- function SelectGatherProject(AProjectID: Integer; AOrgProjs, ANewProjs: TList): Boolean;
- var
- vSelectFrm: TProjGatherSelectForm;
- begin
- vSelectFrm := TProjGatherSelectForm.Create(AProjectID, AOrgProjs);
- 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);
- begin
- inherited Create(nil);
- FProjectID := AProjectID;
- 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;
- begin
- if FSelectProjs.IndexOf(Pointer(ANode.ID)) <> -1 then
- FSelectProjs.Remove(Pointer(ANode.id));
- 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;
- begin
- zgResult.ColCount := 2;
- zgResult.RowCount := 1;
- zgResult.Cells[1, 0].Text := 'ËùÑ¡ÏîÄ¿';
- zgResult.ColWidths[1] := 270;
- 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;
- begin
- for i := 0 to AProjs.Count - 1 do
- FSelectProjs.Add(Pointer(TGatherProjInfo(AProjs.Items[i]).ProjectID));
- end;
- procedure TProjGatherSelectForm.btnOkClick(Sender: TObject);
- begin
- if zgResult.RowCount > 1 then
- ModalResult := mrOk;
- end;
- procedure TProjGatherSelectForm.AssignResult(AProjs: TList);
- var
- iRow: Integer;
- stnNode: TsdIDTreeNode;
- vGatherProj: TGatherProjInfo;
- begin
- for iRow := 1 to zgResult.RowCount - 1 do
- begin
- stnNode := TsdIDTreeNode(zgResult.Rows[iRow].Data);
- vGatherProj := TGatherProjInfo.Create(stnNode.Rec);
- 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;
- end.
|