免费小工具

{-----------------------------------------------------------------------------
 Unit Name: uObjetos
 Author:    CopyRight?2002 - Sebasti醤 Mayor?- Argentina
 eMail :    <a href="mailto:DelphiHelper@Yahoo.com.ar" rel="nofollow">DelphiHelper@Yahoo.com.ar</a> - MySoft@Programmer.net
 Purpose:   How to use Objects to store configuration information
            in windows registry or files.
 History:
 Created:   16/08/2002 21:06:11
-----------------------------------------------------------------------------}
 
unit uObjetos;
 
interface
uses Classes{TComponent}, windows{TRect}, Graphics{TFont};
 
type
 
  TOpciones = class(TComponent)
  private
    {Internal variables, hiden  }
    Archivo: string;            //Filename to store the object
                                //  or
    RegKey : DWord;             //windows Registry Root
    RegPath : string;           //windows Registry Key
    RegSecc : string;           //windows Registry Value
 
    {Properties : Internal representation  }
    fnReal: Double;
    FFont: TFont;
    faRect: Trect;
    FUserName: string;
    fUseReg: Boolean;
    fLastUse: TdateTime;
    fColor: Integer;
    fNoSplash: Boolean;
    fLines: TStrings;//we always create this as TStringList
 
    {Procedures for validating data when assignig values to properties}
    procedure SetFont(const Value: TFont);
    procedure SetUserName(const Value: string);
    function GetScrennRes: TPoint;
    procedure SetLines(const Value: TStrings);
    function GetColor: Integer;
  protected
    {This is ONLY to store properties which are not of type: integer, string, TStrings, TFont y similar}
    {If you work with string, TStrings, TFont and similar properties you don磘 need this procedures }
    procedure DefineProperties(Filer: TFiler); override;
    procedure ReadRect(Reader:Treader);
    procedure WriteRect(Writer:Twriter);
 
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
 
    procedure ReadConfig;
    procedure SaveConfig;
 
    {This property is not stored}
    property ScrennRes: TPoint read GetScrennRes;
  published
   {This properties are stored}
    property ARect       : TRect    read fARect    write fARect;
    property NoSplash    : Boolean  read fNoSplash write fNoSplash;
    property UseRegistry : Boolean  read fUseReg   write FUseReg;
    property UserName    : string   read FUserName write SetUserName;
    property nReal       : Double   read fnReal    write fnReal;
    property Lines       : TStrings read fLines    write SetLines;
    property Font        : TFont    read FFont     write SetFont;
    property LastUse     : TDateTime read fLastUse write fLastUse;
    property Color       : Integer   read GetColor write fColor;
  end;
 
{Functions from Delphi5 help- WriteComponent,TStream }
 
function ComponentToString(Component: TComponent): string;
function StringToComponent(Source: String):TComponent;
 
 
 
var {Global, to use it from anywhere }
  Opciones: TOpciones;
 
implementation
uses SysUtils{ExtractFilePath}, Forms{Screen}, registry{TRegistry};
 
 
{ TOpciones }
{-----------------------------------------------------------------------------
  Algoritmo: StringToComponent
  Comentarios: From Delphi5 Help- WriteComponent,TStream
  returns a component from a given string
-----------------------------------------------------------------------------}
function StringToComponent(Source: String):TComponent;
var
  BinStream:TMemoryStream;
  StrStream: TStringStream;
begin
  StrStream := TStringStream.Create(source);
  try
    BinStream := TMemoryStream.Create;
    try
      Strstream.Seek(0, sofrombeginning);
      ObjectTextToBinary(strStream,binStream);
      BinStream.Seek(0, soFromBeginning);
      Result := BinStream.ReadComponent(Opciones);
    finally
      BinStream.Free
    end;
  finally
    StrStream.Free;
  end;
end;
 
{-----------------------------------------------------------------------------
  Algoritmo: ComponentToString
  Comentarios: From Delphi5 Help- WriteComponent,TStream
  Returns a string representation of a component (like in .dfm files)
-----------------------------------------------------------------------------}
function ComponentToString(Component: TComponent): string;
var
  BinStream:TMemoryStream;
  StrStream: TStringStream;
  s: string;
begin
  BinStream := TMemoryStream.Create;
  try
    StrStream := TStringStream.Create(s);
    try
      BinStream.WriteComponent(Component);
      BinStream.Seek(0, soFromBeginning);
      ObjectBinaryToText(BinStream, StrStream);
      StrStream.Seek(0, soFromBeginning);
      Result:= StrStream.DataString;
    finally
      StrStream.Free;
    end;
  finally
    BinStream.Free
  end;
end;
 
{-----------------------------------------------------------------------------
  Algoritmo: TOpciones.Create
  Comentarios: Create the internal objects, initialize properties to default values
-----------------------------------------------------------------------------}
 
constructor TOpciones.Create(aOwner: TComponent);
begin
  inherited Create(AOWner);
  {Creating internal variables}
  fLines    := TStringList.Create;// use always TStringList, never TStrings.
  fFont     := Tfont.Create;
 
//seting default values
  fLastUse := Now;
  fColor   := 65535;//=clYellow
 
{ File where the object will be stored }
  Archivo     := ExtractFilePath(ParamStr(0)) + 'Config.cfg';
  UseRegistry := not FileExists(archivo);
 
{ Registry Key where the object will be stored}
  RegKey  := HKEY_LOCAL_MACHINE;
  RegPath := '\Software\NiceDemo';// starting with "\" for absolute paths
  RegSecc := 'SillySection';
end;
 
 
destructor TOpciones.Destroy;
begin
//Next line is optional, if omitted (deleted or commented) you must call SaveConfig
//to save the object
  SaveConfig;
 
  {We must free what we create, before Object destruction}
  fLines.Free;
  fFont.Free;
  inherited Destroy;
end;
 
 
{-----------------------------------------------------------------------------
  Algoritmo: TOpciones.GetScrennRes
  Comentarios: Returns the actual ScrennResolution. X = width; Y = height
-----------------------------------------------------------------------------}
function TOpciones.GetScrennRes: Tpoint;
begin
   with Result do
      begin
      x := Screen.width;
      y := Screen.Height;
      end;
end;
 
procedure TOpciones.DefineProperties(Filer: TFiler);
begin
  inherited;
{The property is stored with this name: 'ARECT'
 Which procedure read it : ReadRect
 Which procedure write it: WriteRect
 for more help see online help }
 
  Filer.DefineProperty('ARECT', ReadRect, WriteRect, True);
end;
 
{-----------------------------------------------------------------------------
  Algoritmo: TOpciones.ReadRect
  Comentarios: Internal use. Read the property from where is stored
		(.dfm, external file, stream, etc)
-----------------------------------------------------------------------------}
procedure TOpciones.ReadRect(Reader: Treader);
begin
//Remember: use Farect (not Arect)
  with FARect, Reader do
    begin
    ReadListBegin;
    Left   := ReadInteger;
    Top    := ReadInteger;
    Right  := ReadInteger;
    Bottom := ReadInteger;
    ReadListEnd;
    end;
end;
 
{-----------------------------------------------------------------------------
  Algoritmo: TOpciones.WriteRect
  Comentarios: Complemento de ReadRect.
-----------------------------------------------------------------------------}
procedure TOpciones.WriteRect(Writer: Twriter);
begin
//Remember: use Farect (not Arect)
  with fARect, Writer do
   begin
   WriteListBegin;
   WriteInteger(Left);
   WriteInteger(top);
   WriteInteger(Right);
   WriteInteger(Bottom);
   WriteListEnd;
   end;
end;
 
{-----------------------------------------------------------------------------
  Algoritmo: TOpciones.SaveConfig
  Comentarios: Case UseRegistry of
    True: Store the object in windows registry and delete the file (archivo)
    False:Store the object in the file (archivo) and clear the registry.
-----------------------------------------------------------------------------}
procedure TOpciones.SaveConfig;
begin
  fLastUse := Now;
  with TRegistry.Create do
    try
     RootKey := RegKey;
     if not UseRegistry then
        DeleteKey(regPath)
     else
       begin
       if OpenKey(Regpath, true) then
{We convert the object (self) to string and then save it to registry }
{换}     WriteString(RegSecc, ComponentToString(Self));
       end;
     CloseKey;
    finally
      Free;
    end;
 
  if UseRegistry then
    DeleteFile(archivo)
  else
{We save the object to a file (archivo)}
{换} WriteComponentResFile(Archivo,Self);
end;
 
{-----------------------------------------------------------------------------
  Algoritmo: TOpciones.SetFont
  Comentarios: We must use FFont and never Font.
               When it磗 possible we must use Assign()
-----------------------------------------------------------------------------}
procedure TOpciones.SetFont(const Value: TFont);
begin
  FFont.assign(Value);
end;
 
{-----------------------------------------------------------------------------
  Algoritmo: TOpciones.SetUserName
  Comentarios: Value is the new UserName
   The instruction :
                              Opciones.UserName := 'Papillon';
   The compiler translate it in :
                              Opciones.SetUserName('Papillon');
 
-----------------------------------------------------------------------------}
procedure TOpciones.SetUserName(const Value: string);
begin
  if Value <> '' then
    FUserName := Value
  else
//in place of :
    fUserName := '--Not set--';
// we could use :
//    raise Exception.Create('UserName must have a value');
 
end;
 
{-----------------------------------------------------------------------------
  Algoritmo: TOpciones.ReadConfig
  Comentarios: Case UseRegistry of
	True: try to Read from registry
        False: if the file exists try to read from the file
-----------------------------------------------------------------------------}
procedure TOpciones.ReadConfig;
var S: string;
begin
  try
  if UseRegistry then
    with TRegistry.Create do
      try
        RootKey := RegKey;
        if OpenKey(regPath, False) then
           begin
           S := ReadString(RegSecc);
           if S <> '' then
//"magic" instruction to read from windows registry
{换}         Self := TOpciones(StringToComponent( S ));
           CloseKey;
           end;
      finally
        Free;
      end
  else
   if fileexists(archivo) then
    try
{换}  Self := TOpciones(ReadComponentResFile(Archivo, Self));
    except
      //If you like, you can tell the user "I can磘 read options"
    end
  except
  //If you like, you can tell the user "I can磘 read options"
  end;
end;
 
 
{-----------------------------------------------------------------------------
  Algoritmo: TOpciones.SetLines
  Comentarios: I磎 using fLines in place of Lines to avoid recursive calls
               We use Assign() to copy Value to fLines
-----------------------------------------------------------------------------}
procedure TOpciones.SetLines(const Value: TStrings);
begin
  fLines.Assign(Value);
end;
 
{-----------------------------------------------------------------------------
  Algoritmo: TOpciones.GetColor
  Comentarios: This is just a silly example of GETXXX
 
Within SetXXX and GetXXX we must use local (private) variables in place of 
referencing the properties (I mean Fcolor in place of Color, etc
-----------------------------------------------------------------------------}
function TOpciones.GetColor: Integer;
begin
  Result := ABS(FColor);
//it is equal to
// GetColor := ABS(FColor);
end;
 
initialization
{-----------------------------------------------------------------------------
  Algoritmo: initialization
  Comentarios: Creating the object in this section allow us using it 
    from anywhere and anytime.
    Even from .DPR file and before forms creation.
   Object Opciones is available from the beginning of the application
-----------------------------------------------------------------------------}
  Opciones := TOpciones.Create(nil);
  Opciones.ReadConfig;
 
finalization
//If we create it in Initialization, we destroy it here
  Opciones.Free;
end.