unit rpgGatherControl; interface uses Classes, rpgGatherData, ADODB, ReportManager, ProjectData; type TrpgGatherControl = class private // 当前打开项目,根据其筛选项目 FProjectData: TProjectData; // 当前汇总的报表 -- 主要用于读取报表中的附加信息 FTemplate: TTemplateNode; // 汇总数据 FGatherData: TrpgGatherData; procedure CopyTables(const AFileName, ATableName: string); procedure CopyRelaData; protected FHistroyProjs: TList; // 选择的汇总项目 FSelectProjs: TList; function SelectProject: Boolean; virtual; function SameSelect: Boolean; virtual; procedure RefreshGather; virtual; public constructor Create(AProjectData: TProjectData); virtual; destructor Destroy; override; function RefreshConnection(ATemplate: TTemplateNode): TADOConnection; property ProjectData: TProjectData read FProjectData; property Template: TTemplateNode read FTemplate; property GatherData: TrpgGatherData read FGatherData; end; implementation uses ZhAPI, GatherProjInfo, ProjGather, ProjGatherSelectFrm, Globals, Forms, Controls, UtilMethods, SysUtils; { TrpgGatherControl } constructor TrpgGatherControl.Create(AProjectData: TProjectData); begin FProjectData := AProjectData; FHistroyProjs := TList.Create; FSelectProjs := TList.Create; FGatherData := TrpgGatherData.Create; CopyRelaData; end; destructor TrpgGatherControl.Destroy; begin FGatherData.Free; FSelectProjs.Free; ClearObjects(FHistroyProjs); FHistroyProjs.Free; inherited; end; procedure TrpgGatherControl.CopyRelaData; var sTempFile: string; begin sTempFile := GetTempFileName; try FProjectData.SaveTempDataBaseFile(sTempFile); CopyTables(sTempFile, 'ProjProperties'); finally if FileExists(sTempFile) then DeleteFile(sTempFile); end; end; function TrpgGatherControl.RefreshConnection(ATemplate: TTemplateNode): TADOConnection; begin FTemplate := ATemplate; if SelectProject then begin if not SameSelect then RefreshGather else if Assigned(ATemplate.InteractInfo) then FGatherData.UpdateDataBase(ATemplate.InteractInfo.SpecialProjGatherTypes); end; Result := FGatherData.Connection; end; procedure TrpgGatherControl.RefreshGather; var Gather: TProjGather; begin Screen.Cursor := crHourGlass; Gather := TProjGather.Create(FGatherData.WriteGatherData, ReportConfig.XmjCompare, ReportConfig.GclCompare); try if Assigned(FTemplate.InteractInfo) then Gather.Gather(FSelectProjs, FTemplate.InteractInfo.SpecialProjGatherTypes) else Gather.Gather(FSelectProjs, nil); FGatherData.LoadRelaData(FProjectData.ProjectID); ClearObjects(FHistroyProjs); FHistroyProjs.Assign(FSelectProjs); finally Gather.Free; Screen.Cursor := crDefault; end; end; function TrpgGatherControl.SameSelect: Boolean; function IncludeProj(AList: TList; AProj: TGatherProjInfo): Boolean; var i: Integer; vProj: TGatherProjInfo; begin Result := False; for i := 0 to AList.Count - 1 do begin vProj := TGatherProjInfo(AList.Items[i]); if (AProj.ProjectID = vProj.ProjectID) and (AProj.ProjType = vProj.ProjType) then begin Result := True; Break; end; end; end; function IncludeList(ALarge, ASmall: TList): Boolean; var iSmall: Integer; begin Result := True; for iSmall := 0 to ASmall.Count - 1 do begin if not IncludeProj(ALarge, TGatherProjInfo(ASmall.Items[iSmall])) then begin Result := False; Break; end; end; end; begin if FHistroyProjs.Count = FSelectProjs.Count then Result := IncludeList(FHistroyProjs, FSelectProjs) and IncludeList(FSelectProjs, FHistroyProjs) else Result := False; end; function TrpgGatherControl.SelectProject: Boolean; begin if FTemplate.IsExtra then Result := SelectGatherProject(FProjectData.ProjectID, FSelectProjs, FTemplate.InteractInfo.SpecialProjGatherTypes) else Result := SelectGatherProject(FProjectData.ProjectID, FSelectProjs); end; procedure TrpgGatherControl.CopyTables(const AFileName, ATableName: string); const sCopySql = 'Select * Into %s' + ' From %s In ''%s'''; var vQuery: TADOQuery; begin vQuery := TADOQuery.Create(nil); try vQuery.Connection := FGatherData.Connection; vQuery.SQL.Clear; vQuery.SQL.Add(Format(sCopySql, [ATableName, ATableName, AFileName])); vQuery.ExecSQL; finally vQuery.Free; end; end; end.