jvregauto.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvRegAuto.PAS, released on 2002-07-04.

The Initial Developers of the Original Code are: Andrei Prygounkov <a dott prygounkov att gmx dott de>
Copyright (c) 1999, 2002 Andrei Prygounkov
All Rights Reserved.

Contributor(s):

Last Modified: 2002-07-04

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

component   : JvRegAuto
description : registry and ini-file storage for properties of other components

Known Issues:
  Some russian comments were translated to english; these comments are marked
  with [translated]
-----------------------------------------------------------------------------}

{$I JVCL.INC}

unit JvRegAuto;

interface

uses
  {$IFDEF VCL}
  Windows, SysUtils, Classes, Controls, Forms,
  TypInfo, Registry, IniFiles,
  JvComponent;
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  SysUtils, Classes, QForms,
  //Graphics, Controls, Forms,
  TypInfo, IniFiles;
  {$ENDIF VisualCLX}

type
  TJvIniStrings = class;
  TJvMyIniFile = class;
  TRegAutoOperation = (roBeforeLoad, roAfterLoad, roBeforeSave, roAfterSave);
  TRegAutoEvent = procedure(Sender: TObject; Operation: TRegAutoOperation) of object;
  TStorageMedia = (raRegistry, raIniFile, raIniStrings);

  TJvRegAuto = class(TJvComponent)
  private
    ObjProp: string;
    TypeInf: PTypeInfo;
    PropInf: PPropInfo;
    PropTyp: TTypeKind;
    Obj: TObject;
    ComponentName, PropertyName: string;
    FLoaded: Boolean;
    FProps: TStrings;
    FAutoMode: Boolean;
    FSaveWindowPlace: Boolean;
    CurSection: string;
    CurKey: string;
    FStorage: TStorageMedia;
    {$IFDEF VCL}
    FRegPath: string;
    {$ENDIF VCL}
    FIniFile: string;
    FIniStrings: TStrings;
    FGlobalSettings: Boolean;
    FSection: string;
    FormOnCreate: TNotifyEvent;
    FormOnDestroy: TNotifyEvent;
    FNotifiers: TList;
    FBeforeLoad: TNotifyEvent;
    FBeforeSave: TNotifyEvent;
    FAfterLoad: TNotifyEvent;
    FAfterSave: TNotifyEvent;
    OldIniFile: string;
    {$IFDEF VCL}
    OldRegPath: string;
    {$ENDIF VCL}
    procedure LoadPropInf(lObjProp: string);
    function GetOrdPrp: Longint;
    procedure SetOrdPrp(Value: Longint);
    function GetStrPrp: string;
    procedure SetStrPrp(Value: string);
    function GetFloatPrp: Extended;
    procedure SetFloatPrp(Value: Extended);
    procedure SetFProps(lProps: TStrings);
    {$IFDEF VCL}
    procedure SetSaveWindowPlace(F: Boolean);
    {$ENDIF VCL}
    procedure SetIniStrings(AIniStrings: TStrings);
    function GetUse(Index: TStorageMedia): Boolean;
    procedure SetUse(Index: TStorageMedia; Value: Boolean);
    procedure NewFormOnCreate(Sender: TObject);
    procedure NewFormOnDestroy(Sender: TObject);
    procedure GenerateRegistryName;
    procedure ReadUseRegProperty(Reader: TReader);
    procedure ReadUseIniProperty(Reader: TReader);
    procedure ReadUseStrProperty(Reader: TReader);
  protected
    {$IFDEF VCL}
    Reg: TRegIniFile;
    {$ENDIF VCL}
    Ini: TJvMyIniFile;
    Str: TJvIniStrings;
    procedure CreateFile;
    procedure DestroyFile;
    procedure Loaded; override;
    procedure DefineProperties(Filer: TFiler); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Save;
    procedure Load;
    {$IFDEF VCL}
    procedure SaveWindowPlacement;
    procedure LoadWindowPlacement;
    {$ENDIF VCL}

    {$IFDEF VCL}
    function ReadRootString(const Section, Ident, Default: string): string;
    function ReadRootInteger(const Section, Ident: string; Default: Longint): Longint;
    procedure WriteRootString(const Section, Ident, Value: string);
    procedure WriteRootInteger(const Section, Ident: string; Value: Longint);
    {$ENDIF VCL}
    function ReadString(const Section, Ident, Default: string): string;
    procedure WriteString(const Section, Ident, Value: string);
    function ReadInteger(const Section, Ident: string; Default: Longint): Longint;
    procedure WriteInteger(const Section, Ident: string; Value: Longint);
    function ReadBool(const Section, Ident: string; Default: Boolean): Boolean;
    procedure WriteBool(const Section, Ident: string; Value: Boolean);
    function ReadFloat(const Section, Ident: string; Default: Double): Double;
    procedure WriteFloat(const Section, Ident: string; Value: Double);
    procedure ReadStrings(const Section, Ident: string; Strings: TStrings);
    procedure WriteStrings(const Section, Ident: string; Value: TStrings);
    procedure ReadSection(const Section: string; Ss: TStrings);
    procedure ReadSectionValues(const Section: string; Ss: TStrings);
    procedure ReadSections(Ss: TStrings);
    procedure ReadWholeSection(const Section: string; Ss: TStrings);
    procedure EraseSection(const Section: string);
    procedure DeleteKey(const Section, Ident: string);
    // next three properties are only for compatibility with
    // previous TJvRegAuto versions, don't use them in new programs.
    property UseReg: Boolean index raRegistry read GetUse write SetUse;
    property UseIni: Boolean index raIniFile read GetUse write SetUse;
    property UseStr: Boolean index raIniStrings read GetUse write SetUse;
    procedure AddNotify(ANotify: TRegAutoEvent);
    procedure RemoveNotify(ANotify: TRegAutoEvent);
    function GetFullIniFileName: string;
  published
    // Path in the registry [translated]
    {$IFDEF VCL}
    property RegPath: string read FRegPath write FRegPath;
    property Storage: TStorageMedia read FStorage write FStorage default raRegistry;
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    property Storage: TStorageMedia read FStorage write FStorage default raIniFile;
    {$ENDIF VisualCLX}
    // Name of the ini-file [translated]
    property IniFile: string read FIniFile write FIniFile;
    property IniStrings: TStrings read FIniStrings write SetIniStrings;
    // The list of saved properties [translated]
    property Props: TStrings read FProps write SetFProps;
    property AutoMode: Boolean read FAutoMode write FAutoMode default True;
    // To save a size and position of the window [translated]
    {$IFDEF VCL}
    property SaveWindowPlace: Boolean read FSaveWindowPlace write SetSaveWindowPlace default False;
    {$ENDIF VCL}
    property BeforeLoad: TNotifyEvent read FBeforeLoad write FBeforeLoad;
    property AfterLoad: TNotifyEvent read FAfterLoad write FAfterLoad;
    property BeforeSave: TNotifyEvent read FBeforeSave write FBeforeSave;
    property AfterSave: TNotifyEvent read FAfterSave write FAfterSave;
    property GlobalSettings: Boolean read FGlobalSettings write FGlobalSettings default True;
    property Section: string read FSection write FSection;
  end;

  TJvIniStrings = class(TObject)
  private
    FStrings: TStrings;
  public
    constructor Create(AStrings: TStrings);
    function ReadString(const Section, Ident, Default: string): string;
    procedure WriteString(const Section, Ident, Value: string);
    function ReadInteger(const Section, Ident: string; Default: Longint): Longint;
    procedure WriteInteger(const Section, Ident: string; Value: Longint);
    function ReadBool(const Section, Ident: string; Default: Boolean): Boolean;
    procedure WriteBool(const Section, Ident: string; Value: Boolean);
    function ReadFloat(const Section, Ident: string; Default: Double): Double;
    procedure WriteFloat(const Section, Ident: string; Value: Double);
    function ReadSection(const Section: string; Ss: TStrings): Boolean;
    procedure ReadSectionValues(const Section: string; Ss: TStrings);
    procedure ReadWholeSection(const Section: string; Ss: TStrings);
    procedure ReadSections(Ss: TStrings);
  end;

  TJvMyIniFile = class(TIniFile)
  public
    procedure ReadWholeSection(const Section: string; Ss: TStrings);
  end;

  EJvRegAutoError = class(Exception);

var
  GlobalIniFile: string = ''; {if <> '', used by all RegAutos}
  GlobalRegPath: string = ''; {if <> '', used by all RegAutos}

implementation

uses
  JvJCLUtils, JvDsgnIntf, JvTypes;

const
  cSlash = '/';
  CrLf = #13#10;

function GetUserHome: string;
begin
  {$IFDEF MSWINDOWS}
  {$IFDEF COMPILER6_UP}
  Result := GetEnvironmentVariable('USERPROFILE');
  {$ELSE}
  SetLength(Result, 1024);
  SetLength(Result, GetEnvironmentVariable('USERPROFILE', PChar(Result), 1024));
  {$ENDIF}
  {$ENDIF MSWINDOWS}
  {$IFDEF LINUX}
  Result := GetEnvironmentVariable('HOME');
  {$ENDIF LINUX}
end;

//=== TJvRegAuto =============================================================

constructor TJvRegAuto.Create(AOwner: TComponent);
var
  ProjName: string;
begin
  inherited Create(AOwner);
  FNotifiers := TList.Create;
  {$IFDEF VCL}
  FStorage := raRegistry;
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  FStorage := raIniFile;
  {$ENDIF VisualCLX}
  FGlobalSettings := True;
  FProps := TStringList.Create;
  FIniStrings := TStringList.Create;
  ProjName := '';
  if (csDesigning in ComponentState) and Assigned(GetProjectNameProc) then
  begin
    ProjName := GetProjectNameProc;
    ProjName := ExtractFileName(ProjName);
    ProjName := ChangeFileExt(ProjName, '');
    if ProjName = '' then
      ProjName := 'NONAME';
    {$IFDEF VCL}
    with TRegIniFile.Create('') do
    try
      RootKey := HKEY_LOCAL_MACHINE;
      if Win32Platform = VER_PLATFORM_WIN32_NT then
        FRegPath := 'Software\' + ReadString('Software\Microsoft\Windows NT\CurrentVersion', 'RegisteredOrganization',
          '') + '\' + ProjName
      else
        FRegPath := 'Software\' + ReadString('Software\Microsoft\Windows\CurrentVersion', 'RegisteredOrganization', '') +
          '\' + ProjName;
    finally
      Reg.Free;
    end;
    {$ENDIF VCL}
    FIniFile := '$HOME/.' + ProjName;
  end
  else
  begin
    {$IFDEF VCL}
    FRegPath := 'Software\Unknown Delphi Application';
    {$ENDIF VCL}
  end;
  FAutoMode := True;
  FSaveWindowPlace := False;
end;

destructor TJvRegAuto.Destroy;
begin
  FProps.Free;
  FIniStrings.Free;
  FNotifiers.Free;
  inherited Destroy;
end;

procedure TJvRegAuto.Loaded;

  function EqualAddr(Addr1, Addr2: TNotifyEvent): Boolean;
  begin
    Result := CompareMem(@TMethod(Addr1), @TMethod(Addr2), 8);
  end;

begin
  inherited Loaded;
  if not (csDesigning in ComponentState) and FAutoMode then
    if (Owner is TForm) and
      not EqualAddr((Owner as TForm).OnCreate, NewFormOnCreate) then
    begin
      FormOnCreate := (Owner as TForm).OnCreate;
      (Owner as TForm).OnCreate := NewFormOnCreate;
      FormOnDestroy := (Owner as TForm).OnDestroy;
      (Owner as TForm).OnDestroy := NewFormOnDestroy;
    end
    else
    if (Owner is TDataModule) and
      not EqualAddr((Owner as TDataModule).OnCreate, NewFormOnCreate) then
    begin
      FormOnCreate := (Owner as TDataModule).OnCreate;
      (Owner as TDataModule).OnCreate := NewFormOnCreate;
      FormOnDestroy := (Owner as TDataModule).OnDestroy;
      (Owner as TDataModule).OnDestroy := NewFormOnDestroy;
    end;
end;

procedure TJvRegAuto.NewFormOnCreate(Sender: TObject);
begin
  if Assigned(FormOnCreate) then
    FormOnCreate(Self);
  if AutoMode then
    Load;
end;

procedure TJvRegAuto.NewFormOnDestroy(Sender: TObject);
begin
  if AutoMode then
    Save;
  if Assigned(FormOnDestroy) then
    FormOnDestroy(Self);
end;

procedure TJvRegAuto.LoadPropInf(lObjProp: string);
var
  PropName: string;
  I: Integer;
  Last: Boolean;
begin
  FLoaded := False;
  ObjProp := lObjProp;
  if Length(ObjProp) < 2 then
    Exit;
  ComponentName := Copy(ObjProp, 1, Pos('.', ObjProp) - 1);
  PropertyName := Copy(ObjProp, Pos('.', ObjProp) + 1, 255);
  if ComponentName = Owner.Name then
  begin
    ComponentName := '';
    ObjProp := Copy(ObjProp, Pos('.', ObjProp), 255);
  end;
  if ComponentName = '' then
    Obj := Owner
  else
    Obj := Owner.FindComponent(ComponentName);
  if Obj = nil then
    Exit;

  // We look for nested properties [translated]
  I := Pos('.', ObjProp);
  Last := False;
  while not Last do
  begin
    PropName := '';
    Inc(I);
    while I <= Length(ObjProp) do
    begin
      if ObjProp[I] = '.' then
        Break;
      PropName := PropName + ObjProp[I];
      Inc(I);
    end;
    Last := not ((Length(ObjProp) >= I) and (ObjProp[I] = '.'));
    TypeInf := Obj.ClassInfo;
    PropInf := GetPropInfo(TypeInf, PropName);
    if PropInf = nil then
      Exit;
    PropTyp := PropInf^.PropType^.Kind;
    if Obj = nil then
      Exit;
    if PropTyp = tkClass then
    begin
      FLoaded := True;
      Obj := TObject(GetOrdPrp);
      FLoaded := False;
    end
    else
      Break;
  end;
  FLoaded := True;
end;

procedure TJvRegAuto.GenerateRegistryName;
begin
  if FSection = '' then
    CurSection := Owner.Name
  else
    CurSection := '';
  CurKey := ObjProp;
end;

function TJvRegAuto.GetOrdPrp: Longint;
begin
  Result := 0;
  case PropTyp of
    tkInteger, tkChar, tkWChar, tkClass, tkEnumeration:
      if FLoaded then
        Result := GetOrdProp(Obj, PropInf);
  end;
end;

procedure TJvRegAuto.SetOrdPrp(Value: Longint);
begin
  case PropTyp of
    tkInteger, tkChar, tkWChar, tkEnumeration:
      if FLoaded then
        SetOrdProp(Obj, PropInf, Value);
  end;
end;

function TJvRegAuto.GetStrPrp: string;
begin
  Result := '';
  case PropTyp of
    tkString, tkLString , tkWString :
      if FLoaded then
        Result := GetStrProp(Obj, PropInf);
  end;
end;

procedure TJvRegAuto.SetStrPrp(Value: string);
begin
  case PropTyp of
    tkString, tkLString , tkWString :
      if FLoaded then
        SetStrProp(Obj, PropInf, Value);
  end;
end;

function TJvRegAuto.GetFloatPrp: Extended;
begin
  Result := 0;
  case PropTyp of