registry.htm

对于学习很有帮助

procedure StrToFont(str: string; font: TFont);
begin
     if str = '' then Exit;
     font.Color := StrToInt(tok('|', str));
     font.Height := StrToInt(tok('|', str));
     font.Name := tok('|', str);
     font.Pitch := TFontPitch(StrToInt(tok('|', str)));
     font.PixelsPerInch := StrToInt(tok('|', str));
     font.Size := StrToInt(tok('|', str));
     font.Style := [];
     if str[0] = 'y' then font.Style := font.Style + [fsBold];
     if str[1] = 'y' then font.Style := font.Style + [fsItalic];
     if str[2] = 'y' then font.Style := font.Style + [fsUnderline];
     if str[3] = 'y' then font.Style := font.Style + [fsStrikeout];
end;

function tok(sep: string; var s: string): string;
     function isoneof(c, s: string): Boolean;
     var
        iTmp: integer;
     begin
          Result := False;
          for iTmp := 1 to Length(s) do
          begin
              if c = Copy(s, iTmp, 1) then
              begin
                   Result := True;
                   Exit;
              end;
          end;
     end;
var
   c, t: string;
begin
     if s = '' then
     begin
          Result := s;
          Exit;
     end;
     c := Copy(s, 1, 1);
     while isoneof(c, sep) do
     begin
          s := Copy(s, 2, Length(s) - 1);
          c := Copy(s, 1, 1);
     end;
     t := '';
     while (not isoneof(c, sep)) and (s <> '') do
     begin
          t := t + c;
          s := Copy(s, 2, length(s)-1);
          c := Copy(s, 1, 1);
     end;
     Result := t;
end;
</PRE><HR>

<P>Note that you can keep stuff like this really handy by creating your own subclass of the TIniFile class, and adding routines like this.</P>


<P><H1><A NAME="registry6">How to find the program associated with one file extension</P></A></H1>
<P><I>From: [e-mail] (Stefan Hoffmeister)</I></P>

<PRE>
&gt;I will like to know how to find the program (exe) associated with
&gt;one file extension from register (not win.ini).
</PRE>

<HR><PRE> const
      BufferSize = {$IFDEF Win32} 540 {$ELSE} 80 {$ENDIF};
  var
      Buffer : PChar;
      StringPosition : PChar;
      ReturnedData: Longint;
begin
  Buffer := StrAlloc(BufferSize);
  try
    { get the first entry, don't bother about the version !}
    ReturnedData := BufferSize;
    StrPCopy(Buffer, '.xls');
    RegQueryValue(hKey_Classes_Root, Buffer, Buffer, ReturnedData);
    if StrLen(Buffer) &gt; 0 then
    begin
</PRE><HR>

<H1><A NAME="registry7">Font & Tregistry</A></H1>
<i>From: [e-mail] (Ray Lischner)</i>

On 28 Mar 1997 05:57:38 GMT, "Alex" <[e-mail]>
wrote:
<PRE>
does anybody know a way to save a total Font setting of a
form/panel/listbox etc. etc. to the registry, it's not so dificult doing it
line by line, but with the FontStyle it becomes a lot of lines, so is there
and easy/shorter way ?
</PRE>

Secrets of Delphi 2 has some code that recursively saves any object's
published properties to the registry. The example specifically shows
how it works for TFont. <P>

<HR><PRE>
uses TypInfo;

{ Define a set type for accessing an integer's bits. }
const
  BitsPerByte = 8;
type
  TIntegerSet = set of 0..SizeOf(Integer)*BitsPerByte - 1;

{ Save a set property as a subkey. Each element of the enumerated type
  is a separate Boolean value. True means the item is in the set, and
  False means the item is excluded from the set. This lets the user
  modify the configuration easily, with REGEDIT. }
procedure SaveSetToRegistry(const Name: string; Value: Integer;
   TypeInfo: PTypeInfo; Reg: TRegistry);
var
  OldKey: string;
  I: Integer;
begin
  TypeInfo := GetTypeData(TypeInfo)^.CompType;
  OldKey := '\' + Reg.CurrentPath;
  if not Reg.OpenKey(Name, True) then
    raise ERegistryException.CreateFmt('Cannot create key: %s',
[Name]);

  { Loop over all the items in the enumerated type. }
  with GetTypeData(TypeInfo)^ do
    for I := MinValue to MaxValue do
      { Write a Boolean value for each set element. }
      Reg.WriteBool(GetEnumName(TypeInfo, I), I in
TIntegerSet(Value));

  { Return to the parent key. }
  Reg.OpenKey(OldKey, False);
end;

{ Save an object to the registry by saving it as a subkey. }
procedure SaveObjToRegistry(const Name: string; Obj: TPersistent;
   Reg: TRegistry);
var
  OldKey: string;
begin
  OldKey := '\' + Reg.CurrentPath;
  { Open a subkey for the object. }
  if not Reg.OpenKey(Name, True) then
    raise ERegistryException.CreateFmt('Cannot create key: %s',
[Name]);

  { Save the object's properties. }
  SaveToRegistry(Obj, Reg);

  { Return to the parent key. }
  Reg.OpenKey(OldKey, False);
end;

{ Save a method to the registry by saving its name. }
procedure SaveMethodToRegistry(const Name: string; const Method:
TMethod;
   Reg: TRegistry);
var
  MethodName: string;
begin
  { If the method pointer is nil, then store an empty string. }
  if Method.Code = nil then
    MethodName := ''
  else
    { Look up the method name. }
    MethodName := TObject(Method.Data).MethodName(Method.Code);
  Reg.WriteString(Name, MethodName);
end;

{ Save a single property to the registry, as a value of the current
key. }
procedure SavePropToRegistry(Obj: TPersistent; PropInfo: PPropInfo;
Reg: TRegistry);
begin
  with PropInfo^ do
    case PropType^.Kind of
    tkInteger,
    tkChar,
    tkWChar:
      { Store ordinal properties as integer. }
      Reg.WriteInteger(Name, GetOrdProp(Obj, PropInfo));
    tkEnumeration:
      { Store enumerated values by name. }
      Reg.WriteString(Name, GetEnumName(PropType, GetOrdProp(Obj,
PropInfo)));
    tkFloat:
      { Store floating point values as Doubles. }
      Reg.WriteFloat(Name, GetFloatProp(Obj, PropInfo));
    tkString,
    tkLString:
      { Store strings as strings. }
      Reg.WriteString(Name, GetStrProp(Obj, PropInfo));
    tkVariant:
      { Store variant values as strings. }
      Reg.WriteString(Name, GetVariantProp(Obj, PropInfo));      
    tkSet:
      { Store a set as a subkey. }
      SaveSetToRegistry(Name, GetOrdProp(Obj, PropInfo), PropType,
Reg);
    tkClass:
      { Store a class as a subkey, with its properties as values
        of the subkey. }
      SaveObjToRegistry(Name, TPersistent(GetOrdProp(Obj, PropInfo)),
Reg);
    tkMethod:
      { Save a method by name. }
      SaveMethodToRegistry(Name, GetMethodProp(Obj, PropInfo), Reg);
    end;
end;

{ Save an object to the registry by storing its published properties.
}
procedure SaveToRegistry(Obj: TPersistent; Reg: TRegistry);
var
  PropList: PPropList;
  PropCount: Integer;
  I: Integer;
begin
  { Get the list of published properties. }
  PropCount := GetTypeData(Obj.ClassInfo)^.PropCount;
  GetMem(PropList, PropCount*SizeOf(PPropInfo));
  try
    GetPropInfos(Obj.ClassInfo, PropList);
    { Store each property as a value of the current key. }
    for I := 0 to PropCount-1 do
      SavePropToRegistry(Obj, PropList^[I], Reg);
  finally
    FreeMem(PropList, PropCount*SizeOf(PPropInfo));
  end;
end;

{ Save the published properties as values of the given key.
  The key is relative to HKEY_CURRENT_USER. }
procedure SaveToKey(Obj: TPersistent; const KeyPath: string);
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    if not Reg.OpenKey(KeyPath, True) then
      raise ERegistryException.CreateFmt('Cannot create key: %s',
[KeyPath]);
    SaveToRegistry(Obj, Reg);
  finally
    Reg.Free;
  end;
end;
</PRE><HR>

<HR SIZE="6" color="#00FF00">
<FONT SIZE="2">
<a href="mailto:[e-mail]">Please email me</a> and tell me if you liked this page.<BR>
<SCRIPT LANGUAGE="JavaScript">
<!--
	document.write("Last modified " + document.lastModified);
// -->
</SCRIPT><P>
<TABLE BORDER=0 ALIGN="CENTER">
<TR>
	<TD>This page has been created with </TD>
	<TD> <A HREF="http://www.dexnet.com./homesite.html"><IMG SRC="../images/hs25ani.gif" WIDTH=88 HEIGHT=31 BORDER=0 ALT="HomeSite 2.5b">
</A></TD>
</TR>
</TABLE>

</FONT>


</BODY>
</HTML>