BillsEditor/Reports/UI/ScReportCompareFrm.pas

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.