unitfrmmain.pas

来自「精彩编程百例26～50 其中有 控制任务栏 windows底层任务控制 屏保预览」· PAS 代码 · 共 78 行

unit unitFrmMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, registry,
  StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    txtedit: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}
//参数说明:
//ft:文件名后缀，如可以为'.txt'
//key:后缀在注册表中的键值，具有唯一性
//desc:关于关联程序的描述
//icon:缺省的程序图标，如Application.ExeName+',1'，也可以缺省
//prg:对应的应用程序

procedure registerfiletype(ft, key, desc, icon, prg: string);
var myreg: treginifile;
  c: integer;
begin


  c := pos('.', ft);        //从字符串中取得第一个'.'的位置
  while c > 0 do begin     //判断该'.'字符是否是在后缀所带的'.'字符
    delete(ft, c, 1);   //截取'.'后的所有字符
    c := pos('.', ft);      //重新取得'.'字符的位置
  end;
  if (ft = '') or (prg = '') then exit; //判断后缀及应用程序是否有效
  ft := '.' + ft;
  myreg := treginifile.create('');
  try
    myreg.rootkey := hkey_classes_root; // 在HKEY_CLASSES_ROOT表中写入
    if key = '' then key := copy(ft, 2, maxint) + '_auto_file';
    // 若键值未给出，则自动创建一个
    myreg.writestring(ft, '', key); // 写入描述的键值
    myreg.writestring(key, '', desc); // 写入描述
    if icon <> '' then
      myreg.writestring(key + '\DefaultIcon', '', icon);
    // 写入缺省图标
    myreg.writestring(key + '\shell\open\command', '', prg + ' "%1"');
    //写入相关联的应用程序
  finally
    myreg.free;
  end;
end;

//指定本程序和扩展名为exp的文件关联
procedure TForm1.Button1Click(Sender: TObject);
var
s:string;
begin
  s:=txtedit.Text+label2.Caption;
  registerFileType('.txt', 'txtfile', '测试关联文件', s + ',1', s);
  ShowMessage(s+'已和扩展名为txt的文件关联');

end;

end.