unit
Preferences;
interface
uses
Windows, SysUtils, Classes, Forms, Registry, ShellAPI;
const
RegBase = 'Software\Company name\Software name\';
type
TOptionsBase =
class
protected
procedure
ReadStrValue(R : TRegistry; AName :
String
;
var
AValue :
String
);
procedure
ReadIntValue(R : TRegistry; AName :
String
;
var
AValue :
Integer
);
procedure
ReadBoolValue(R : TRegistry; AName :
String
;
var
AValue :
Boolean
);
end
;
TWndLayout =
class
(TOptionsBase)
private
FWndTop :
Integer
;
FWndLeft :
Integer
;
FWndWidth :
Integer
;
FWndHeight :
Integer
;
FIsMaximized :
Boolean
;
FDataBaseWidth :
Integer
;
FDiscHeight :
Integer
;
FDiscInfoWidth :
Integer
;
FDiscFoldersWidth :
Integer
;
FMediaList: TStringList;
FFilesList : TStringList;
public
constructor
Create;
destructor
Destroy; override;
procedure
Save(R : TRegistry);
procedure
Load(R : TRegistry);
property
WndTop :
Integer
read FWndTop
write
FWndTop;
property
WndLeft :
Integer
read FWndLeft
write
FWndLeft;
property
WndWidth :
Integer
read FWndWidth
write
FWndWidth;
property
WndHeight :
Integer
read FWndHeight
write
FWndHeight;
property
IsMaximized :
Boolean
read FIsMaximized
write
FIsMaximized;
property
DatabaseWidth :
Integer
read FDatabaseWidth
write
FDatabaseWidth;
property
DiscHeight :
Integer
read FDiscHeight
write
FDiscHeight;
property
DiscInfoWidth :
Integer
read FDiscInfoWidth
write
FDiscInfoWidth;
property
DiscFoldersWidth :
Integer
read FDiscFoldersWidth
write
FDiscFoldersWidth;
property
MediaList : TStringList read FMediaList;
property
FilesList : TStringList read FFilesList;
end
;
TGeneral =
class
(TOptionsBase)
private
FLoadLast :
Boolean
;
FSelectAll :
Boolean
;
FLoadLastFile :
String
;
public
constructor
Create;
procedure
Save(R : TRegistry);
procedure
Load(R : TRegistry);
property
LoadLast :
Boolean
read FLoadLast
write
FLoadLast;
property
SelectAll :
Boolean
read FSelectAll
write
FSelectAll;
property
LoadLastFile :
String
read FLoadLastFile
write
FLoadLastFile;
end
;
TPreferences =
class
private
FLayout : TWndLayout;
FGeneral : TGeneral;
public
constructor
Create;
destructor
Destroy; override;
procedure
Load;
procedure
Save;
property
Layout : TWndLayout read FLayout;
property
General : TGeneral read FGeneral;
end
;
procedure
CallLink(ALink:
String
);
implementation
procedure
CallLink(ALink:
String
);
begin
ShellExecute(Application
.
Handle,
PChar
(
'open'
),
PChar
(ALink),
Nil
,
Nil
,SW_SHOW);
end
;
procedure
TOptionsBase
.
ReadBoolValue(R: TRegistry; AName:
String
;
var
AValue:
Boolean
);
begin
If
R
.
ValueExists(AName)
Then
AValue := R
.
ReadBool(AName);
end
;
procedure
TOptionsBase
.
ReadIntValue(R: TRegistry; AName:
String
;
var
AValue:
Integer
);
begin
If
R
.
ValueExists(AName)
Then
AValue := R
.
ReadInteger(AName);
end
;
procedure
TOptionsBase
.
ReadStrValue(R: TRegistry; AName:
String
;
var
AValue:
String
);
begin
AValue :=
''
;
If
R
.
ValueExists(AName)
Then
AValue := R
.
ReadString(AName);
end
;
constructor
TWndLayout
.
Create;
begin
FMediaList := TStringList
.
Create;
FFilesList := TStringList
.
Create;
FWndTop :=
50
;
FWndLeft :=
50
;
FWndWidth :=
850
;
FWndHeight :=
640
;
FIsMaximized :=
False
;
FDataBaseWidth :=
190
;
FDiscHeight :=
250
;
FDiscInfoWidth :=
240
;
FDiscFoldersWidth :=
240
;
end
;
destructor
TWndLayout
.
Destroy;
begin
FMediaList
.
Free;
FFilesList
.
Free;
inherited
;
end
;
procedure
TWndLayout
.
Load(R : TRegistry);
var
I :
Integer
;
Buf :
String
;
begin
If
R
.
OpenKeyReadOnly(RegBase + 'Layout\')
Then
Begin
ReadIntValue(R,
'WndTop'
,FWndTop);
ReadIntValue(R,
'WndLeft'
,FWndLeft);
ReadIntValue(R,
'WndWidth'
,FWndWidth);
ReadIntValue(R,
'WndHeight'
,FWndHeight);
ReadBoolValue(R,
'IsMaximized'
,FIsMaximized);
ReadIntValue(R,
'DataBaseWidth'
,FDataBaseWidth);
ReadIntValue(R,
'DiscHeight'
,FDiscHeight);
ReadIntValue(R,
'DiscInfoWidth'
,FDiscInfoWidth);
ReadIntValue(R,
'DiscFoldersWidth'
,FDiscFoldersWidth);
R
.
CloseKey;
End
;
If
R
.
OpenKeyReadOnly(RegBase + 'Layout\Media\')
Then
Begin
For
I :=
0
To
FMediaList
.
Count-
1
Do
Begin
ReadStrValue(R,FMediaList
.
Names[i],Buf);
FMediaList
.
Values[FMediaList
.
Names[i]] := Buf;
End
;
R
.
CloseKey;
End
;
If
R
.
OpenKeyReadOnly(RegBase + 'Layout\Files\')
Then
Begin
For
I :=
0
To
FFilesList
.
Count-
1
Do
Begin
ReadStrValue(R,FFilesList
.
Names[i],Buf);
If
Buf <>
''
Then
FFilesList
.
Values[FFilesList
.
Names[i]] := Buf;
End
;
R
.
CloseKey;
End
;
end
;
procedure
TWndLayout
.
Save(R : TRegistry);
var
I :
Integer
;
begin
If
R
.
OpenKey(RegBase + 'Layout\',
True
)
Then
Begin
R
.
WriteInteger(
'WndTop'
,FWndTop);
R
.
WriteInteger(
'WndLeft'
,FWndLeft);
R
.
WriteInteger(
'WndWidth'
,FWndWidth);
R
.
WriteInteger(
'WndHeight'
,FWndHeight);
R
.
WriteBool(
'IsMaximized'
,FIsMaximized);
R
.
WriteInteger(
'DataBaseWidth'
,FDataBaseWidth);
R
.
WriteInteger(
'DiscHeight'
,FDiscHeight);
R
.
WriteInteger(
'DiscInfoWidth'
,FDiscInfoWidth);
R
.
WriteInteger(
'DiscFoldersWidth'
,FDiscFoldersWidth);
R
.
CloseKey;
End
;
If
R
.
OpenKey(RegBase + 'Layout\Media\',
True
)
Then
Begin
For
I :=
0
To
FMediaList
.
Count-
1
Do
R
.
WriteString(FMediaList
.
Names[i],FMediaList
.
ValueFromIndex[i]);
R
.
CloseKey;
End
;
If
R
.
OpenKey(RegBase + 'Layout\Files\',
True
)
Then
Begin
For
I :=
0
To
FFilesList
.
Count-
1
Do
R
.
WriteString(FFilesList
.
Names[i],FFilesList
.
ValueFromIndex[i]);
R
.
CloseKey;
End
;
end
;
constructor
TPreferences
.
Create;
begin
FLayout := TWndLayout
.
Create;
FGeneral := TGeneral
.
Create;
end
;
destructor
TPreferences
.
Destroy;
begin
FLayout
.
Free;
FGeneral
.
Free;
inherited
;
end
;
procedure
TPreferences
.
Load;
var
R : TRegistry;
begin
R := TRegistry
.
Create;
R
.
RootKey := HKEY_CURRENT_USER;
Try
FLayout
.
Load(R);
FGeneral
.
Load(R);
Finally
R
.
Free;
End
;
end
;
procedure
TPreferences
.
Save;
var
R : TRegistry;
begin
R := TRegistry
.
Create;
R
.
RootKey := HKEY_CURRENT_USER;
Try
FLayout
.
Save(R);
FGeneral
.
Save(R);
Finally
R
.
Free;
End
;
end
;
constructor
TGeneral
.
Create;
begin
FLoadLast :=
True
;
FSelectAll :=
False
;
FLoadLastFile := ExtractFilePath(Application
.
ExeName) +
'Default.cdi'
;
end
;
procedure
TGeneral
.
Load(R: TRegistry);
begin
If
R
.
OpenKeyReadOnly(RegBase + 'General\')
Then
Begin
{$I include\reg_crypt_begin.inc}
ReadBoolValue(R,
'LoadLast'
,FLoadLast);
ReadStrValue(R,
'LoadLastFile'
,FLoadLastFile);
{$I include\reg_crypt_end.inc}
ReadBoolValue(R,
'SelectAll'
,FSelectAll);
R
.
CloseKey;
End
;
end
;
procedure
TGeneral
.
Save(R: TRegistry);
begin
If
R
.
OpenKey(RegBase + 'General\',
True
)
Then
Begin
R
.
WriteBool(
'LoadLast'
,FLoadLast);
R
.
WriteBool(
'SelectAll'
,FSelectAll);
R
.
WriteString(
'LoadLastFile'
,FLoadLastFile);
R
.
CloseKey;
End
;
end
;
end
.