1 | unit Unit14_settings; |
---|
2 | interface |
---|
3 | uses |
---|
4 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, |
---|
5 | Dialogs, StdCtrls, StrUtils; |
---|
6 | |
---|
7 | type |
---|
8 | TForm14 = class(TForm) |
---|
9 | check_filesashex: TCheckBox; |
---|
10 | btn_ok: TButton; |
---|
11 | btn_cancel: TButton; |
---|
12 | btn_register_oldb: TButton; |
---|
13 | btn_register_opf: TButton; |
---|
14 | btn_register_dat: TButton; |
---|
15 | procedure btn_register_opfClick(Sender: TObject); |
---|
16 | procedure btn_register_oldbClick(Sender: TObject); |
---|
17 | procedure btn_register_datClick(Sender: TObject); |
---|
18 | procedure btn_cancelClick(Sender: TObject); |
---|
19 | procedure btn_okClick(Sender: TObject); |
---|
20 | procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); |
---|
21 | procedure FormShow(Sender: TObject); |
---|
22 | function RegisterExtension(ext:String):Integer; |
---|
23 | private |
---|
24 | public |
---|
25 | end; |
---|
26 | |
---|
27 | var |
---|
28 | Form14: TForm14; |
---|
29 | |
---|
30 | implementation |
---|
31 | {$R *.dfm} |
---|
32 | uses |
---|
33 | Unit1_main, Unit3_data, ftypesAPI; |
---|
34 | |
---|
35 | function ExtensionRegistered(ext:String; var RegisteredAs:String):Boolean; |
---|
36 | var |
---|
37 | ftr:TFileTypeRegistration; |
---|
38 | begin |
---|
39 | ftr:=TFileTypeRegistration.Create; |
---|
40 | if(ftr <> nil) then begin |
---|
41 | try |
---|
42 | RegisteredAs:=ftr.GetInternalKey(ext); |
---|
43 | if RegisteredAs<>'' then |
---|
44 | Result:=True |
---|
45 | else |
---|
46 | Result:=False; |
---|
47 | finally |
---|
48 | ftr.Free; |
---|
49 | end; |
---|
50 | end; |
---|
51 | end; |
---|
52 | |
---|
53 | function TForm14.RegisterExtension(ext:String):Integer; |
---|
54 | var |
---|
55 | ftr:TFileTypeRegistration; |
---|
56 | temps:String; |
---|
57 | warnmsg:String; |
---|
58 | begin |
---|
59 | Result:=-1; |
---|
60 | if ExtensionRegistered(ext,temps) then begin |
---|
61 | if temps<>'ONI'+ext then begin |
---|
62 | warnmsg:=ext+'-files are not registered to OUP but as "'+temps+'"-files.'+#13+#10+ |
---|
63 | 'Do you really want to unregister'+ext+'-files?'; |
---|
64 | if MessageBox(Self.Handle, PChar(warnmsg),PChar('Warning'),MB_YESNO)=ID_NO then |
---|
65 | Exit; |
---|
66 | end; |
---|
67 | ftr:=TFileTypeRegistration.Create; |
---|
68 | if ftr<>nil then |
---|
69 | try |
---|
70 | if not ftr.UnregisterExtension(ext) then |
---|
71 | ShowMessage('Could not unregister '+ext+'-files') |
---|
72 | else |
---|
73 | Result:=2; |
---|
74 | finally |
---|
75 | ftr.Free; |
---|
76 | end; |
---|
77 | end else begin |
---|
78 | ftr:=TFileTypeRegistration.Create; |
---|
79 | if ftr<>nil then begin |
---|
80 | try |
---|
81 | if ftr.RegisterType(ext,'ONI'+ext,'ONI '+ext+'-file',Application.EXEname+',1') then begin |
---|
82 | ftr.AddHandler('open','"'+Application.EXEname+'" '+MidStr(ext,2,Length(ext)-1)+' "%1"'); |
---|
83 | ftr.SetDefaultHandler; |
---|
84 | Result:=1; |
---|
85 | end; |
---|
86 | finally |
---|
87 | ftr.Free; |
---|
88 | end; |
---|
89 | end; |
---|
90 | end; |
---|
91 | end; |
---|
92 | |
---|
93 | procedure TForm14.btn_cancelClick(Sender: TObject); |
---|
94 | begin |
---|
95 | Self.Close; |
---|
96 | end; |
---|
97 | |
---|
98 | procedure TForm14.btn_okClick(Sender: TObject); |
---|
99 | begin |
---|
100 | AppSettings.FilenumbersAsHex:=check_filesashex.Checked; |
---|
101 | Self.Close; |
---|
102 | end; |
---|
103 | |
---|
104 | procedure TForm14.btn_register_datClick(Sender: TObject); |
---|
105 | begin |
---|
106 | case RegisterExtension('.dat') of |
---|
107 | 2: btn_register_dat.Caption:='Register .dat files with OUP'; |
---|
108 | 1: btn_register_dat.Caption:='Unregister .dat files'; |
---|
109 | end; |
---|
110 | end; |
---|
111 | |
---|
112 | procedure TForm14.btn_register_oldbClick(Sender: TObject); |
---|
113 | begin |
---|
114 | case RegisterExtension('.oldb') of |
---|
115 | 2: btn_register_oldb.Caption:='Register .oldb files with OUP'; |
---|
116 | 1: btn_register_oldb.Caption:='Unregister .oldb files'; |
---|
117 | end; |
---|
118 | end; |
---|
119 | |
---|
120 | procedure TForm14.btn_register_opfClick(Sender: TObject); |
---|
121 | begin |
---|
122 | case RegisterExtension('.opf') of |
---|
123 | 2: btn_register_opf.Caption:='Register .opf files with OUP'; |
---|
124 | 1: btn_register_opf.Caption:='Unregister .opf files'; |
---|
125 | end; |
---|
126 | end; |
---|
127 | |
---|
128 | procedure TForm14.FormCloseQuery(Sender: TObject; var CanClose: Boolean); |
---|
129 | begin |
---|
130 | CanClose:=False; |
---|
131 | Self.Visible:=False; |
---|
132 | Form1.Enabled:=True; |
---|
133 | Form1.SetFocus; |
---|
134 | end; |
---|
135 | |
---|
136 | procedure TForm14.FormShow(Sender: TObject); |
---|
137 | var |
---|
138 | temps:String; |
---|
139 | begin |
---|
140 | if ExtensionRegistered('.dat',temps) then |
---|
141 | btn_register_dat.Caption:='Unregister .dat files' |
---|
142 | else |
---|
143 | btn_register_dat.Caption:='Register .dat files with OUP'; |
---|
144 | if ExtensionRegistered('.oldb',temps) then |
---|
145 | btn_register_oldb.Caption:='Unregister .oldb files' |
---|
146 | else |
---|
147 | btn_register_oldb.Caption:='Register .oldb files with OUP'; |
---|
148 | if ExtensionRegistered('.opf',temps) then |
---|
149 | btn_register_opf.Caption:='Unregister .opf files' |
---|
150 | else |
---|
151 | btn_register_opf.Caption:='Register .opf files with OUP'; |
---|
152 | check_filesashex.Checked:=AppSettings.FilenumbersAsHex; |
---|
153 | end; |
---|
154 | |
---|
155 | end. |
---|