fir.pas

一个用delphi写的安装程序. 涉及到的知识: 1.注册表的使用 2.资源文件的制作,使用 3.多线程中api播放wav 4.快捷方式

unit fir;

{+++++++++++++++++++++++++++++++++++++++
===   unit fir;
===   安装程序的配制部分;
===   如果有人认为不太详尽的话,也可以装此
===   部分分为两个窗体或是更多等.
===   程序的外观有待于改进.
===   欢迎指正;
+++++++++++++++++++++++++++++++++++++++}

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls,filectrl,registry,jpeg;

type
  Tfrmfir = class(TForm)
    imgleft: TImage;
    pnl1: TPanel;
    pnl2: TPanel;
    Label1: TLabel;
    Memo1: TMemo;
    chky: TCheckBox;
    btnexit: TButton;
    btnnext: TButton;
    btnpri: TButton;
    lbltit2: TLabel;
    edtpath: TEdit;
    lblpath: TLabel;
    btnpath: TButton;
    gbsome: TGroupBox;
    chbdemo: TCheckBox;
    chbprogram: TCheckBox;
    chbpascal: TCheckBox;
    pnl3: TPanel;
    Label2: TLabel;
    chbdesktop: TCheckBox;
    chbstart: TCheckBox;
    chbautostart: TCheckBox;
    chbrun: TCheckBox;
    pnl4: TPanel;
    Label3: TLabel;
    mmoinfo: TMemo;
    nbmain: TNotebook;
    procedure chkyClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnpathClick(Sender: TObject);
    procedure chbprogramClick(Sender: TObject);
    procedure chbpascalClick(Sender: TObject);
    procedure chbdesktopClick(Sender: TObject);
    procedure chbstartClick(Sender: TObject);
    procedure chbrunClick(Sender: TObject);
    procedure edtpathChange(Sender: TObject);
    procedure btnnextClick(Sender: TObject);
    procedure btnpriClick(Sender: TObject);
    procedure btnexitClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure chbautostartClick(Sender: TObject);
  private
    setupinfo:array [1..6] of string;       //用于汇聚安装信息;
    exity:boolean;                         //确定安装,或不安装退出;
  public
    { Public declarations }
  end;

var
  frmfir: Tfrmfir;

implementation
uses main,sec;

{$R *.dfm}

procedure Tfrmfir.chkyClick(Sender: TObject);
begin
  btnnext.Enabled:=chky.Checked;
end;

procedure Tfrmfir.FormCreate(Sender: TObject);
begin
  myreg:=tregistry.Create;
  myreg.RootKey:=hkey_local_machine;
  myreg.OpenKey('software\tresss',true);  //为自己的软件在注册表里设置一个位置;
  //if myreg.ReadInteger('ver')>1 then    //如果发现已安装过此软件,而且版本比当前版本高时...;
  setupath:=myreg.ReadString('path');
  if setupath<>'' then  //如果注册表里有以前的安装信息,则设置路径为以前安装时的路径直;
    edtpath.Text:=setupath;
  sprogram:=true; //初始化;
  spascal:=true;
  sdesktop:=true;
  sstart:=true;
  autorun:=true;
  setupinfo[1]:='安装信息:';                     //安装信息初始化;
  setupinfo[2]:='安装组件:神奇动画,编程大师如果说,pascal精要';
  setupinfo[3]:='安装路径:'+setupath;
  setupinfo[4]:='创建快捷方式:桌面,开始';
  setupinfo[5]:='开机自启动:非';
  setupinfo[6]:='安装完成自动运行软件:是';
end;

procedure Tfrmfir.btnpathClick(Sender: TObject);
begin
  if selectdirectory('安装演示','',setupath) then   //选择文件夹,uses filectrl;
    edtpath.Text:=setupath;
end;

procedure Tfrmfir.chbprogramClick(Sender: TObject);
begin
  sprogram:=chbprogram.Checked;
  setupinfo[2]:='安装组件:神奇动画';    //更改安装信息;
  if chbprogram.Checked then
    setupinfo[2]:=setupinfo[2]+',编程大师如果说';
  if chbprogram.Checked then
    setupinfo[2]:=setupinfo[2]+',pascal精要';
end;

procedure Tfrmfir.chbpascalClick(Sender: TObject);
begin
  spascal:=chbpascal.Checked;
  setupinfo[2]:='安装组件:神奇动画';      //更改安装信息;
  if chbprogram.Checked then
    setupinfo[2]:=setupinfo[2]+',编程大师如果说';
  if chbprogram.Checked then
    setupinfo[2]:=setupinfo[2]+',pascal精要';
end;

procedure Tfrmfir.chbdesktopClick(Sender: TObject);
begin
  sdesktop:=chbdesktop.checked;
  setupinfo[4]:='创建快捷方式:';     //更改安装信息;
  if chbdesktop.Checked then
    setupinfo[4]:=setupinfo[4]+' 桌面';
  if chbstart.Checked then
    setupinfo[4]:=setupinfo[4]+' 开始';
end;

procedure Tfrmfir.chbstartClick(Sender: TObject);
begin
  sstart:=chbstart.Checked;
  setupinfo[4]:='创建快捷方式:';     //更改安装信息;
  if chbdesktop.Checked then
    setupinfo[4]:=setupinfo[4]+' 桌面';
  if chbstart.Checked then
    setupinfo[4]:=setupinfo[4]+' 开始';
end;

procedure Tfrmfir.chbrunClick(Sender: TObject);
begin
  autorun:=chbrun.Checked;
  if chbrun.Checked then        //更改安装信息;
    setupinfo[6]:='安装完成自动运行软件:是'
  else
    setupinfo[6]:='安装完成自动运行软件:否';
end;

procedure Tfrmfir.edtpathChange(Sender: TObject);
begin
  setupath:=edtpath.Text;
  setupinfo[3]:='安装路径:'+setupath;
end;

procedure Tfrmfir.btnnextClick(Sender: TObject);
var
  k:integer;
begin
  nbmain.PageIndex:=nbmain.PageIndex+1;
  if nbmain.pageindex=3 then
  begin
    mmoinfo.Clear;
    for k:=1 to 6 do          //写入安装信息;
     mmoinfo.lines.Add(setupinfo[k]);
    btnnext.Enabled:=false;
    btnexit.Caption:='安装';
  end;
  if nbmain.pageindex=1 then
    btnpri.Enabled:=true;
end;

procedure Tfrmfir.btnpriClick(Sender: TObject);
begin
  nbmain.PageIndex:=nbmain.PageIndex-1;
  if nbmain.pageindex=2 then
  begin
    btnexit.Caption:='退出';
    btnnext.Enabled:=true;
  end;
  if nbmain.pageindex=0 then
    btnpri.Enabled:=false;
end;

procedure Tfrmfir.btnexitClick(Sender: TObject);
begin
  if btnexit.Caption='退出' then         //未安装而退出;
  begin
    if messagebox(handle,'确定要退出本程序的安装吗?','退出安装',mb_okcancel)=1 then
      frmain.Close;
  end
  else
  begin               //进行安装;
    exity:=true;
    frmfir.hide;
    application.ProcessMessages;
    frmain.showsec;
  end;
end;

procedure Tfrmfir.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if not exity then
    if messagebox(handle,'确定要退出本程序的安装吗?','退出安装',mb_okcancel)=1 then
        frmain.Close
    else
    canclose:=false;
end;

procedure Tfrmfir.chbautostartClick(Sender: TObject);
begin
  autostart:=chbautostart.Checked;
  if chky.Checked then            //更改安装信息;
    setupinfo[5]:='开机自启动:是'
  else
    setupinfo[5]:='开机自启动:否';
end;

end.