propfilereh.int

delphi控件源码,第三方空间 ,第三方空间

{*******************************************************}
{                                                       }
{    Delphi / Kylix Cross-Platform Runtime Library      }
{                                                       }
{                     EhLib v3.6                        }
{                                                       }
{          TPropWriter, TPropReader objects             }
{                                                       }
{   Copyright (c) 2002-2004 by Dmitry V. Bolshakov      }
{                                                       }
{*******************************************************}

{$I EhLib.Inc}
//{$I EhLibClx.Inc}

{$IFDEF EH_LIB_CLX}
unit QPropFilerEh;
{$ELSE}
unit PropFilerEh {$IFDEF CIL} platform {$ENDIF};
{$ENDIF}

interface

uses
{$IFDEF EH_LIB_CLX}
  Types, QForms, QGraphics, QControls,
{$ELSE}
  Windows, Forms, Controls,
  {$IFDEF EH_LIB_6} Variants, Types, {$ENDIF}

{$IFDEF CIL}
  EhLibVCLNET,
  System.Runtime.InteropServices, System.Reflection,
{$ELSE}
  EhLibVCL,
{$ENDIF}

{$ENDIF} //$ELSE EH_LIB_CLX
  SysUtils, Classes, TypInfo;

type
  TPropWriterEh = class;
  TPropReaderEh = class;

  TWriteOwnerPropsEventEh = procedure(Writer: TPropWriterEh) of object;
  TReadOwnerPropEventEh = procedure(Reader: TPropReaderEh; PropName: String;
    var Processed: Boolean) of object;

 {TPropWriterEh}

  TPropWriterEh = class(TWriter)
  private
    FCurRootsList: TList;
    FDefnBinPropList: TStringList;
    FDefnPropList: TStringList;
    FInterceptorList: TList;
    FLastRootsList: TList;
//    FLookupRoot: TComponent;
    FPropPath: String;
    FOnWriteOwnerProps: TWriteOwnerPropsEventEh;
    procedure BuildPropsList(AObject: TObject; sl: TStrings);
  protected
    procedure WriteAllProperties(Instance: TObject);
  public
    constructor Create(Stream: TStream; BufSize: Integer);
    destructor Destroy; override;
    procedure WritePropName(const PropName: string);
    procedure DefineBinaryProperty(const Name: string; ReadData, WriteData: TStreamProc; HasData: Boolean); override;
    procedure DefineObjectProperties(Instance: TObject);
    procedure DefineProperty(const Name: string; ReadData: TReaderProc; WriteData: TWriterProc; HasData: Boolean); override;
    procedure SaveObjectProperyValue(Instance: TObject; Path, FullPath: String);
    procedure WriteCollection(Value: TCollection);
    procedure WriteOwnerProperties(Owner: TComponent; PropList: TStrings);
    property OnWriteOwnerProps: TWriteOwnerPropsEventEh read FOnWriteOwnerProps write FOnWriteOwnerProps;
  end;

 {TPropReaderEh}

  TPropReaderEh = class(TReader)
  private
    FCanHandleExcepts: Boolean;
    FCollectionList: TList;
    FInterceptorList: TList;
    FPropName: String;
    FOnReadOwnerProp: TReadOwnerPropEventEh;
    function ReadSet(SetType: PTypeInfo): Integer;
    procedure SkipSetBody;
{$IFNDEF EH_LIB_5}
    procedure SkipValue;
    procedure SkipProperty;
    procedure PropertyError;
{$ENDIF}
  protected
    function Error(const Message: string): Boolean; override;
    procedure ReadCollection(Collection: TCollection);
    procedure ReadProperty(AInstance: TPersistent);
    procedure ReadPropValue(Instance: TPersistent; PropInfo: PPropInfo);
  public
    constructor Create(Stream: TStream; BufSize: Integer);
    destructor Destroy; override;
    procedure DefineBinaryProperty(const Name: string; ReadData,
      WriteData: TStreamProc; HasData: Boolean); override;
    procedure DefineProperty(const Name: string; ReadData: TReaderProc;
      WriteData: TWriterProc; HasData: Boolean); override;
    procedure ReadComponent(Component: TComponent);
    procedure ReadOwnerProperties(Component: TComponent);
    property OnReadOwnerProp: TReadOwnerPropEventEh read FOnReadOwnerProp write FOnReadOwnerProp;
  end;

{ TStoragePropertyInterceptor }

  TStoragePropertyInterceptor = class(TPersistent)
    FTarget: TObject;
  public
    constructor Create(ATarget: TObject); virtual;
    function NeedIntercept: Boolean; virtual;
    procedure Readed; virtual;
    property Target: TObject read FTarget;
  end;

{ TFormStoragePropertyInterceptor }

  TFormStoragePropertyInterceptor = class(TStoragePropertyInterceptor)
  private
    FActiveControl: TWinControl;
    FHeight: Integer;
    FLeft: Integer;
    FPixelsPerInch: Integer;
    FPosPresent: Boolean;
    FTop: Integer;
    FWidth: Integer;
    FWindowState: TWindowState;
    function GetHeight: Integer;
    function GetLeft: Integer;
    function GetTop: Integer;
    function GetWidth: Integer;
    procedure SetLeft(const Value: Integer);
    procedure SetTop(const Value: Integer);
  public
    constructor Create(ATarget: TObject); override;
    procedure Readed; override;
    function GetNotmalFormPlacement: TRect;
  published
    property ActiveControl: TWinControl write FActiveControl;
    property Height: Integer read GetHeight write FHeight;
    property Left: Integer read GetLeft write SetLeft;
    property PixelsPerInch: Integer write FPixelsPerInch;
    property Top: Integer read GetTop write SetTop;
    property Width: Integer read GetWidth write FWidth;
    property WindowState: TWindowState write FWindowState;
  end;

  TReadPropertyInterceptorClass = class of TStoragePropertyInterceptor;

  procedure RegisterReadPropertyInterceptor(Target: TClass; Interceptor: TReadPropertyInterceptorClass);
  procedure UnregisterReadPropertyInterceptor(Target: TClass; Interceptor: TReadPropertyInterceptorClass);
  function GetInterceptorForTarget(Target: TClass): TReadPropertyInterceptorClass;

  function GetNextPointSeparatedToken(Path: String): String;

  procedure GetComponentChildListEh(ParentComp, Root: TComponent; cl: TStrings; CheckInline: Boolean);
  function FindChildComponent(ParentComp, Root: TComponent; const AName: string; CheckInline: Boolean): TComponent;

var
  IsRaiseReadErrorEh: Boolean = False;

implementation