settingsstorage.pas

CVS IDE plugin for Borland Delphi this is a good program,i like this kind of practise

unit SettingsStorage;
(* $Id: SettingsStorage.pas,v 1.3 2002/12/27 16:22:43 turbo Exp $
 *
 * Macros for quickly saving and restoring dialog settings in the registry
 *
 * Copyright 2002 by Thomas Bleier
 * For license details see LICENSE.txt
 *)

//---------------------------------------------------------------------------
interface
{$I BORCVS.inc}
uses
  Classes,
  Controls,
  windows,
  StdCtrls,
  registry;

procedure BEGIN_SAVE_SETTINGS(key: string);
procedure SAVE_STRING_SETTING(name, value: string);
procedure SAVE_INT_SETTING(name: string; value: integer);
procedure SAVE_FLOAT_SETTING(name: string; value: double);
procedure SAVE_BOOL_SETTING(name: string; value: boolean);
procedure SAVE_DATE_SETTING(name: string; value: Tdate);
procedure SAVE_DATETIME_SETTING(name: string; value: TdateTime);
procedure SAVE_TIME_SETTING(name: string; value: TTime);
procedure SAVE_STRINGS_SETTING(name: string; value: TStrings);
procedure SAVE_COMBOEDIT_SETTING(name: string; combo: TcomboBox);
procedure SAVE_COMBOLIST_SETTING(name: string; combo: TcomboBox);
procedure END_SAVE_SETTINGS;

procedure BEGIN_LOAD_SETTINGS(key: string);
function LOAD_STRING_SETTING(name: string; default: string): string;
function LOAD_INT_SETTING(name: string; default: integer): integer;
procedure LOAD_FLOAT_SETTING(name: string; var value, default: double);
function LOAD_BOOL_SETTING(name: string; default: boolean): boolean;
procedure LOAD_DATE_SETTING(name: string; var value, default: tdate);
procedure LOAD_DATETIME_SETTING(name: string; var value, default: TdateTime);
procedure LOAD_TIME_SETTING(name: string; var value, default: TTime);
procedure LOAD_STRINGS_SETTING(name: string; value: Tstrings; default: string);
procedure LOAD_COMBOEDIT_SETTING(name: string; combo: TcomboBox; default:
  string);
procedure LOAD_COMBOLIST_SETTING(name: string; combo: TcomboBox; default:
  string);
procedure END_LOAD_SETTINGS;

procedure ADD_COMBO_TEXT_ENTRY(control: TcomboBox; text: string);
procedure ADD_COMBO_MRU_ENTRY(control: TcomboBox);
procedure ADD_COMBO_TEXT_ENTRY_MAX(control: TcomboBox; text: string; max:
  integer);
procedure ADD_COMBO_MRU_ENTRY_MAX(control: TcomboBox; max: integer);

const
  DEFAULT_MRU_ENTRIES = 20;

var
//  RegistrySettingsKey: string;
  SAVE_SETTINGS_BASEKEY: string;
  RegistrySettingsRoot: HKEY;

var
  reg: TRegistry;

implementation
uses
  sysutils,
  PELDebugit;

//---------------------------------------------------------------------------
// Error Messages
//---------------------------------------------------------------------------

resourcestring
  SAVE_SETTINGS_ERROR = 'Error saving settings! ';
  LOAD_SETTINGS_ERROR = 'Error loading settings! ';

//---------------------------------------------------------------------------
// Saving settings
//---------------------------------------------------------------------------

procedure BEGIN_SAVE_SETTINGS(key: string);
begin
  reg := TRegistry.Create;
  reg.RootKey := RegistrySettingsRoot;
  if not (reg.OpenKey(SAVE_SETTINGS_BASEKEY + '\' + key, true)) then
  begin
{$IFOPT D+}
    DebugStr(SAVE_SETTINGS_ERROR + SAVE_SETTINGS_BASEKEY + '\' + key);
{$ENDIF D+}
    raise Exception.Create(SAVE_SETTINGS_ERROR);
  end;
end;

procedure SAVE_STRING_SETTING(name, value: string);
begin
  reg.WriteString(name, value);
end;

procedure SAVE_INT_SETTING(name: string; value: integer);
begin
  reg.WriteInteger(name, value);
end;

procedure SAVE_FLOAT_SETTING(name: string; value: double);
begin
  reg.WriteFloat(name, value);
end;

procedure SAVE_BOOL_SETTING(name: string; value: boolean);
begin
  reg.WriteBool(name, value);
end;

procedure SAVE_DATE_SETTING(name: string; value: Tdate);
begin
  reg.WriteDate(name, value);
end;

procedure SAVE_DATETIME_SETTING(name: string; value: TdateTime);
begin
  reg.WriteDateTime(name, value);
end;

procedure SAVE_TIME_SETTING(name: string; value: TTime);
begin
  reg.WriteTime(name, value);
end;

procedure SAVE_STRINGS_SETTING(name: string; value: TStrings);
begin
  reg.WriteString(name, value.Text);
end;

procedure SAVE_COMBOEDIT_SETTING(name: string; combo: TcomboBox);
begin
  SAVE_STRINGS_SETTING(name + 'List', combo.Items);
  SAVE_STRING_SETTING(name, combo.Text);
end;

procedure SAVE_COMBOLIST_SETTING(name: string; combo: TcomboBox);
begin
  SAVE_STRINGS_SETTING(name + 'List', combo.Items);
  SAVE_INT_SETTING(name, combo.ItemIndex);
end;

procedure END_SAVE_SETTINGS;
begin
  reg.Free;
end;

//---------------------------------------------------------------------------
// Loading settings
//---------------------------------------------------------------------------

procedure BEGIN_LOAD_SETTINGS(key: string);
begin
  reg := TRegistry.Create;
  reg.RootKey := RegistrySettingsRoot;
  if not (reg.OpenKey(SAVE_SETTINGS_BASEKEY + '\' + key, false)) then
  begin
{$IFOPT D+}
    DebugStr(LOAD_SETTINGS_ERROR + SAVE_SETTINGS_BASEKEY + '\' + key);
{$ENDIF D+}
    raise Exception.Create(LOAD_SETTINGS_ERROR);
  end;
end;

function LOAD_STRING_SETTING(name: string; default: string): string;
begin
  if (reg <> nil) and (reg.ValueExists(name)) then
    result := reg.ReadString(name)
  else
    result := default;
end;

function LOAD_INT_SETTING(name: string; default: integer): integer;
//procedure LOAD_INT_SETTING(name: string; var value: integer; default: integer);
begin
  if (reg <> nil) and (reg.ValueExists(name)) then
    result := reg.ReadInteger(name)
  else
    result := default;
end;

procedure LOAD_FLOAT_SETTING(name: string; var value, default: double);
begin
  if (reg <> nil) and (reg.ValueExists(name)) then
    value := reg.ReadFloat(name)

  else
    value := default;
end;

function LOAD_BOOL_SETTING(name: string; default: boolean): boolean;
//procedure LOAD_BOOL_SETTING(name: string; var value, default: boolean);
begin
  if (reg <> nil) and (reg.ValueExists(name)) then
    result := reg.ReadBool(name)
  else
    result := default;
end;

procedure LOAD_DATE_SETTING(name: string; var value, default: tdate);
begin
  if (reg <> nil) and (reg.ValueExists(name)) then
    value := reg.ReadDate(name)
  else
    value := default;
end;

procedure LOAD_DATETIME_SETTING(name: string; var value, default: TdateTime);
begin
  if (reg <> nil) and (reg.ValueExists(name)) then
    value := reg.ReadDateTime(name)
  else
    value := default;
end;

procedure LOAD_TIME_SETTING(name: string; var value, default: TTime);
begin
  if (reg <> nil) and (reg.ValueExists(name)) then
    value := reg.ReadTime(name)
  else
    value := default;
end;

procedure LOAD_STRINGS_SETTING(name: string; value: Tstrings; default: string);
begin
  if (reg <> nil) and (reg.ValueExists(name)) then
    (value).Text := reg.ReadString(name)
  else
    (value).Text := default;
end;

procedure LOAD_COMBOEDIT_SETTING(name: string; combo: TcomboBox; default:
  string);
begin
  LOAD_STRINGS_SETTING(name + 'List', combo.Items, '');
  combo.Text := LOAD_STRING_SETTING(name, '');
end;

procedure LOAD_COMBOLIST_SETTING(name: string; combo: TcomboBox; default:
  string);
begin
  LOAD_STRINGS_SETTING(name + 'List', combo.Items, default);
  combo.ItemIndex := LOAD_INT_SETTING(name, 0);
end;

procedure END_LOAD_SETTINGS;
begin
  reg.Free;
end;

//---------------------------------------------------------------------------
// MRU handling
//---------------------------------------------------------------------------

procedure ADD_COMBO_TEXT_ENTRY(control: TcomboBox; text: string);
var
  current: string;
  p: integer;
begin
  current := text;
  if (current <> '') then
  begin
    p := control.Items.IndexOf(current);
    if (p >= 0) then
      control.Items.Delete(p);
    control.Items.Insert(0, current);
    control.ItemIndex := 0;
  end;
end;

procedure ADD_COMBO_MRU_ENTRY(control: TcomboBox);
begin
  ADD_COMBO_TEXT_ENTRY(control, control.Text);
end;

procedure ADD_COMBO_TEXT_ENTRY_MAX(control: TcomboBox; text: string; max:
  integer);
var
  current: string;
  i, p: integer;
  items: TStrings;
begin
  current := text;
  if (current <> '') then
  begin
    items := control.Items;
    items.BeginUpdate;
    try
      p := items.IndexOf(current);
      if (p >= 0) then
        items.Delete(p);
      items.Insert(0, current);
      control.ItemIndex := 0;
      for i := items.Count - max downto 1 do
        items.Delete(items.Count);
    finally
      items.EndUpdate;
    end;
  end;
end;

procedure ADD_COMBO_MRU_ENTRY_MAX(control: TcomboBox; max: integer);
begin
  ADD_COMBO_TEXT_ENTRY_MAX(control, control.Text, max);
end;
end.