ufmmain.pas

装DevExpress控件时很麻烦,总提示某某控件得先装才行。于是做了这个工具。稍改改就可以用于自己的控件安装了。

unit ufmMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ExtCtrls, StdCtrls, uComponentInstaller, Buttons,
  RzCmboBx;

type
  TfrmMain = class(TForm)
    Panel2: TPanel;
    LabelTitle: TLabel;
    Bevel1: TBevel;
    Image1: TImage;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Timer1: TTimer;
    Panel1: TPanel;
    Bevel2: TBevel;
    ButtonCancel: TButton;
    ListView1: TListView;
    Panel3: TPanel;
    BitBtn1: TSpeedButton;
    BitBtn2: TSpeedButton;
    BitBtn3: TSpeedButton;
    Panel4: TPanel;
    Label1: TLabel;
    Panel5: TPanel;
    Label2: TLabel;
    Memo1: TMemo;
    btnInst: TButton;
    Label3: TLabel;
    Edit1: TEdit;
    OpenDialog1: TOpenDialog;
    BitBtn4: TSpeedButton;
    Edit2: TRzComboBox;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ButtonCancelClick(Sender: TObject);
    procedure btnInstClick(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
  private
    { Private declarations }
  public
    AppPath: string;
    Installer: TSpMultiInstaller;
    { Public declarations }
    function Install: Boolean;
    function CloseDelphi: Boolean;
  end;


var
  frmMain: TfrmMain;

implementation

{$R *.dfm}
const
  rvSetupIni = 'vcl2006.txt';
  crIDC_HAND = 32649;

{ TfrmMain }

function TfrmMain.CloseDelphi: Boolean;
begin
  Result := False;
  Exit; //调试时用

  while not Result and ((FindWindow('TAppBuilder', nil) <> 0) or (FindWindow('TAppBuilder', nil) <> 0)) do
  begin
    Application.BringToFront;
    Result := Application.MessageBox('请先关闭所有Delphi环境。', '',
      MB_OKCANCEL + MB_ICONWARNING) = IDCANCEL;
  end;
  if Result then
    Close;
end;

function TfrmMain.Install: Boolean;
begin
  Application.ProcessMessages;
  if Installer.Install(Trim(Edit1.Text),SpStringToIDEType(Edit2.Text),Memo1.Lines) then
    ButtonCancel.Caption := '完成(&X)';
end;

procedure TfrmMain.FormCreate(Sender: TObject);
var i: integer;
begin
  Screen.Cursors[crIDC_HAND] := LoadCursor(0, IDC_HAND);
  for i:=0 to PageControl1.PageCount-1 do
    PageControl1.Pages[i].TabVisible := False;
  PageControl1.ActivePageIndex := 0;

  AppPath := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName));
  Installer := TSpMultiInstaller.Create(AppPath + rvSetupIni);

  LabelTitle.Caption := '银星Delphi2006开发环境控件包安装...';
  OpenDialog1.InitialDir := AppPath;

end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  Installer.Free;
end;

procedure TfrmMain.FormShow(Sender: TObject);
var i: Integer;
begin
  if CloseDelphi then Exit;

  Edit2.Text := SpIDETypeToString(Installer.ComponentPackages.MinimumIDE);
  for i:=0 to Installer.ComponentPackages.Count-1 do
  begin
    with ListView1.Items.Add do
    begin
      Caption := Installer.ComponentPackages.Items[i].Name;
      SubItems.Add(Installer.ComponentPackages.Items[i].Destination);
      SubItems.Add(Installer.ComponentPackages.Items[i].SearchPath);
    end;
  end;
end;

procedure TfrmMain.BitBtn4Click(Sender: TObject);
begin
  if not OpenDialog1.Execute then exit;

  Installer.ComponentPackages.LoadFromIni(OpenDialog1.FileName);
  ListView1.Clear;
  FormShow(nil);
end;

procedure TfrmMain.ButtonCancelClick(Sender: TObject);
begin
  close;
end;

procedure TfrmMain.btnInstClick(Sender: TObject);
var i,n: integer;
begin
  n:=0;
  for i:=0 to ListView1.Items.Count-1 do
  begin
    if ListView1.Items[i].Checked then
    begin
     Inc(n);
     Installer.ComponentPackages.Items[i].Installable := sitInstallable;
    end else
     Installer.ComponentPackages.Items[i].Installable := sitNotInstallable;
  end;
  if n=0 then
  begin
    ShowMessage('请先选择要安装的控件');
    exit;
  end ;

  PageControl1.ActivePageIndex := 1;
  btnInst.Enabled := false;
  Install;
end;

procedure TfrmMain.BitBtn1Click(Sender: TObject);
var i: integer;
begin
  for i:=0 to ListView1.Items.Count-1 do
  begin
    ListView1.Items[i].Checked := True;
  end;
end;

procedure TfrmMain.BitBtn2Click(Sender: TObject);
var i: integer;
begin
  for i:=0 to ListView1.Items.Count-1 do
  begin
    ListView1.Items[i].Checked := false;
  end;
end;

procedure TfrmMain.BitBtn3Click(Sender: TObject);
var i: integer;
begin
  for i:=0 to ListView1.Items.Count-1 do
  begin
    ListView1.Items[i].Checked := not ListView1.Items[i].Checked;
  end;
end;

end.