unit ScReportCompareFrm; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, CheckLst, ComCtrls, ToolWin, ImgList, ProjectsDM; type TScReportCompareForm = class(TForm) btnCompare: TButton; btnClose: TButton; Panel1: TPanel; ImageList1: TImageList; Panel2: TPanel; ToolBar1: TToolBar; tbtnCompareAdd: TToolButton; ToolButton1: TToolButton; tbtnCompareUpMove: TToolButton; tbtnCompareDownMove: TToolButton; clbCompareProjects: TCheckListBox; Panel3: TPanel; ToolBar2: TToolBar; tbtnSourceAdd: TToolButton; ToolButton3: TToolButton; tbtnSourceUpMove: TToolButton; tbtnSourceDownMove: TToolButton; clbSourceProjects: TCheckListBox; Splitter1: TSplitter; Panel4: TPanel; procedure btnCompareClick(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormCreate(Sender: TObject); procedure btnCloseClick(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure FormDestroy(Sender: TObject); procedure tbtnCompareUpMoveClick(Sender: TObject); procedure tbtnSourceUpMoveClick(Sender: TObject); procedure tbtnCompareDownMoveClick(Sender: TObject); procedure tbtnSourceDownMoveClick(Sender: TObject); procedure tbtnCompareAddClick(Sender: TObject); procedure tbtnSourceAddClick(Sender: TObject); procedure clbCompareProjectsClickCheck(Sender: TObject); procedure clbSourceProjectsClickCheck(Sender: TObject); procedure FormShow(Sender: TObject); private { Private declarations } FDM: TScProjectCompareDM; FCompare, FSource: string; FCanClose: Boolean; FCompareAlias: string; FSourceAlias: string; {init views} procedure InitViews; procedure FreeObjects(const AClbProject: TCheckListBox); function DoCheckProject(const AclbProject: TCheckListBox): string; {check and add items} function CheckItemExists(const AclbProject: TCheckListBox; const AFileName: string): Integer; procedure AddItem(const AclbProject: TCheckListBox; const AFileName, AAlias: string); function SelectOtherProject(const AclbProject: TCheckListBox; const AIsCompare: Boolean): string; function BrowsProjectFile(const AIsCompare: Boolean; var vAlias: string): string; {move items} procedure UpMoveProject(const AclbProject: TCheckListBox); procedure DownMoveProject(const AclbProject: TCheckListBox); procedure SetCompare(const Value: string); procedure SetSource(const Value: string); procedure DivideNames(var AProjName, AAliasName: string; const AName: string); public { Public declarations } procedure CompositeCompareName(const ABuildName, AAlias: string); property DM: TScProjectCompareDM read FDM; property Compare: string read FCompare write SetCompare; property Source: string read FSource write SetSource; property CompareAlias: string read FCompareAlias write FCompareAlias; property SourceAlias: string read FSourceAlias write FSourceAlias; end; var ScReportCompareForm: TScReportCompareForm; implementation uses ScFileArchiver, ScUtils, ScConfig, ScReportsFrm, ScBrowseProjectFileFrm; {$R *.dfm} type TProjectName = record FileName: string; end; PProjectName = ^TProjectName; procedure TScReportCompareForm.btnCompareClick(Sender: TObject); begin FCanClose := False; if not FileExists(FCompare) then begin MessageHint(Handle, '请选择审核项目文件!'); Exit; end; if not FileExists(FSource) then begin MessageHint(Handle, '请选择原报项目文件!'); Exit; end; FCanClose := True; Screen.Cursor := crHourGlass; try Hide; // lsm 2010-1-22 if CompareType = CompareBills then FDM.CompareProjsForReports(FCompare, FSource) else if CompareType = CompareMaterial then FDM.CompareMaterial(FCompare, FSource) else if CompareType = CompareRation then FDM.CompareRations(FCompare, FSource); finally Screen.Cursor := crDefault; end; end; procedure TScReportCompareForm.FormClose(Sender: TObject; var Action: TCloseAction); begin Action := caHide; end; procedure TScReportCompareForm.FormCreate(Sender: TObject); begin FCanClose := True; FDM := TScProjectCompareDM.Create(nil); end; procedure TScReportCompareForm.btnCloseClick(Sender: TObject); begin FCanClose := True; end; procedure TScReportCompareForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin CanClose := FCanClose; end; procedure TScReportCompareForm.SetCompare(const Value: string); begin FCompare := Value; end; procedure TScReportCompareForm.SetSource(const Value: string); begin FSource := Value; end; procedure TScReportCompareForm.FormDestroy(Sender: TObject); begin FDM.Free; FreeObjects(clbCompareProjects); FreeObjects(clbSourceProjects); end; procedure TScReportCompareForm.tbtnCompareUpMoveClick(Sender: TObject); begin UpMoveProject(clbCompareProjects); end; procedure TScReportCompareForm.tbtnSourceUpMoveClick(Sender: TObject); begin UpMoveProject(clbSourceProjects); end; procedure TScReportCompareForm.tbtnCompareDownMoveClick(Sender: TObject); begin DownMoveProject(clbCompareProjects); end; procedure TScReportCompareForm.tbtnSourceDownMoveClick(Sender: TObject); begin DownMoveProject(clbSourceProjects); end; procedure TScReportCompareForm.DownMoveProject( const AclbProject: TCheckListBox); var iIdx: Integer; begin iIdx := AclbProject.ItemIndex; if iIdx = AclbProject.Count - 1 then Exit; AclbProject.Items.Exchange(iIdx, iIdx + 1); end; procedure TScReportCompareForm.UpMoveProject( const AclbProject: TCheckListBox); var iIdx: Integer; begin iIdx := AclbProject.ItemIndex; if iIdx = 0 then Exit; AclbProject.Items.Exchange(iIdx, iIdx - 1); end; procedure TScReportCompareForm.AddItem(const AclbProject: TCheckListBox; const AFileName, AAlias: string); var iIdx: Integer; projectNameRec: PProjectName; begin if CheckItemExists(AclbProject, AAlias) < 0 then begin New(ProjectNameRec); projectNameRec.FileName := AFileName; iIdx := AclbProject.Items.AddObject(AAlias, TObject(projectNameRec)); AclbProject.Checked[iIdx] := True; end; end; function TScReportCompareForm.CheckItemExists( const AclbProject: TCheckListBox; const AFileName: string): Integer; var I: Integer; begin Result := -1; for I := 0 to AclbProject.Items.Count - 1 do begin if SameText(AclbProject.Items[I], AFileName) then begin AclbProject.Checked[I] := True; Result := I; end else AclbProject.Checked[I] := False; end; end; function TScReportCompareForm.SelectOtherProject( const AclbProject: TCheckListBox; const AIsCompare: Boolean): string; var strAlias: string; begin Result := BrowsProjectFile(AIsCompare, strAlias); if Result <> '' then begin AddItem(AclbProject, Result, strAlias); if AIsCompare then FCompareAlias := strAlias else FSourceAlias := strAlias; end; end; procedure TScReportCompareForm.tbtnCompareAddClick(Sender: TObject); begin FCompare := SelectOtherProject(clbCompareProjects, True); end; procedure TScReportCompareForm.tbtnSourceAddClick(Sender: TObject); begin FSource := SelectOtherProject(clbSourceProjects, False); end; procedure TScReportCompareForm.InitViews; begin clbCompareProjects.Clear; clbSourceProjects.Clear; if not SameText(FCompare, '') then AddItem(clbCompareProjects, FCompare, FCompareAlias); if not SameText(FSource, '') then AddItem(clbSourceProjects, FSource, FSourceAlias); end; function TScReportCompareForm.DoCheckProject( const AclbProject: TCheckListBox): string; var bChecked: Boolean; I, iItemIdx: Integer; projectNameRec: PProjectName; begin Result := ''; iItemIdx := AclbProject.ItemIndex; bChecked := AclbProject.Checked[iItemIdx]; if bChecked then begin projectNameRec := PProjectName(AclbProject.Items.Objects[iItemIdx]); Result := projectNameRec.FileName; end; for I := 0 to AclbProject.Items.Count - 1 do begin if I <> iItemIdx then AclbProject.Checked[I] := False; end; end; procedure TScReportCompareForm.clbCompareProjectsClickCheck( Sender: TObject); begin FCompare := DoCheckProject(clbCompareProjects); end; procedure TScReportCompareForm.clbSourceProjectsClickCheck( Sender: TObject); begin FSource := DoCheckProject(clbSourceProjects); end; procedure TScReportCompareForm.FormShow(Sender: TObject); begin InitViews; end; procedure TScReportCompareForm.FreeObjects( const AClbProject: TCheckListBox); var I: Integer; projectNameRec: PProjectName; begin for I := 0 to AClbProject.Items.Count - 1 do begin projectNameRec := PProjectName(AClbProject.Items.Objects[I]); Dispose(projectNameRec); end; AClbProject.Clear; end; procedure TScReportCompareForm.CompositeCompareName(const ABuildName, AAlias: string); begin FCompare := ProjectManager.GetProjectFileName(ABuildName, AAlias); end; procedure TScReportCompareForm.DivideNames(var AProjName, AAliasName: string; const AName: string); begin AProjName := Copy(AName, 1, Pos('\', AName) - 1); AAliasName := Copy(AName, Pos('\', AName) + 1, Length(AName)); end; function TScReportCompareForm.BrowsProjectFile( const AIsCompare: Boolean; var vAlias: string): string; var strFile, strBuildProject, strAlias: string; begin Result := ''; vAlias := ''; case AIsCompare of True: DivideNames(strBuildProject, strAlias, FCompare); False: DivideNames(strBuildProject, strAlias, FSource); end; if BrowseProjectFile(strFile, strBuildProject, strAlias, True) then begin if not FileExists(strFile) then begin MessageWarning(Handle, Format('文件[%s]不存在!', [strAlias])); Exit; end; if not IsSmartCostProjectFile(strFile) then begin MessageWarning(Handle, Format('文件[%s]不是有效的SmartCost项目文件!', [strAlias])); Exit; end; Result := strFile; vAlias := Format('%s\%s', [strBuildProject, strAlias]); end; end; end.