source: oup/releases/0.31a/Unit14_settings.pas@ 647

Last change on this file since 647 was 34, checked in by alloc, 18 years ago
File size: 4.4 KB
RevLine 
[34]1unit Unit14_settings;
2interface
3uses
4 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
5 Dialogs, StdCtrls, StrUtils;
6
7type
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
27var
28 Form14: TForm14;
29
30implementation
31{$R *.dfm}
32uses
33 Unit1_main, Unit3_data, ftypesAPI;
34
35function 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
53function 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
93procedure TForm14.btn_cancelClick(Sender: TObject);
94 begin
95 Self.Close;
96 end;
97
98procedure TForm14.btn_okClick(Sender: TObject);
99 begin
100 AppSettings.FilenumbersAsHex:=check_filesashex.Checked;
101 Self.Close;
102 end;
103
104procedure 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
112procedure 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
120procedure 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
128procedure 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
136procedure 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
155end.
Note: See TracBrowser for help on using the repository browser.