cxpropeditors.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 564 行 · 第 1/2 页

{********************************************************************}
{                                                                    }
{           Developer Express Visual Component Library               }
{           Express Cross Platform Library classes                   }
{                                                                    }
{           Copyright (c) 2000-2008 Developer Express Inc.           }
{           ALL RIGHTS RESERVED                                      }
{                                                                    }
{   The entire contents of this file is protected by U.S. and        }
{   International Copyright Laws. Unauthorized reproduction,         }
{   reverse-engineering, and distribution of all or any portion of   }
{   the code contained in this file is strictly prohibited and may   }
{   result in severe civil and criminal penalties and will be        }
{   prosecuted to the maximum extent possible under the law.         }
{                                                                    }
{   RESTRICTIONS                                                     }
{                                                                    }
{   THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES            }
{   (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE     }
{   SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS    }
{   LICENSED TO DISTRIBUTE THE EXPRESSCROSSPLATFORMLIBRARY AND ALL   }
{   ACCOMPANYING VCL CONTROLS AS PART OF AN EXECUTABLE PROGRAM       }
{   ONLY.                                                            }
{                                                                    }
{   THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED       }
{   FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE         }
{   COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE        }
{   AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT   }
{   AND PERMISSION FROM DEVELOPER EXPRESS INC.                       }
{                                                                    }
{   CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON        }
{   ADDITIONAL RESTRICTIONS.                                         }
{                                                                    }
{********************************************************************}

unit cxPropEditors;

interface

{$I cxVer.inc}

uses
{$IFDEF DELPHI6}
    DesignIntf, DesignEditors, VCLEditors,
  Types,
{$ELSE}
  DsgnIntf,
{$ENDIF}
  Windows, Messages, SysUtils, Classes, Graphics, Controls, TypInfo, cxContainer,
  ImgList;

type
  TcxNestedEventProperty = class(TMethodProperty)
  protected
    function GetInstance: TPersistent; virtual; abstract;
  public
    function GetAttributes: TPropertyAttributes; override;
    function GetName: string; override;
    procedure GetProperties(Proc: {$IFDEF DELPHI6}TGetPropProc{$ELSE}TGetPropEditProc{$ENDIF}); override;
    function GetValue: string; override;

    property Instance: TPersistent read GetInstance;
  end;

  TcxNestedParentElementEventProperty = class(TNestedProperty)
  private
    FOwner: TPersistent;
    FPropInfo: PPropInfo;
    FParent: TPropertyEditor;

    function GetInstance: TPersistent;
  protected
    constructor Create(Parent: TPropertyEditor; AOwner: TPersistent; APropInfo: PPropInfo); reintroduce;
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetProperties(Proc: {$IFDEF DELPHI6}TGetPropProc{$ELSE}TGetPropEditProc{$ENDIF}); override;
    function GetValue: string; override;
    function GetName: string; override;

    property Instance: TPersistent read GetInstance;
  end;

  TcxNestedElementEventProperty = class(TNestedProperty)
  private
    FParent: TPropertyEditor;
    FPropInfo: PPropInfo;

    function GetTrimmedEventName: string;
    function GetPersistentClassNames: string;
    function GetInstance: TPersistent;
  protected
    constructor Create(Parent: TPropertyEditor; APropInfo: PPropInfo); reintroduce;

    function GetFormMethodName: string; virtual;
    property Instance: TPersistent read GetInstance;
  public
    function AllEqual: Boolean; override;
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
    function GetEditLimit: Integer; override;
    function GetName: string; override;
    function GetValue: string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const AValue: string); override;
  end;

  { TImageIndexProperty }

  TImageIndexProperty = class(TIntegerProperty{$IFDEF DELPHI6}, ICustomPropertyListDrawing{$ENDIF})
  public
    function GetImages: TCustomImageList; virtual; abstract;
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
    procedure ListMeasureHeight(const Value: string; ACanvas: TCanvas;
      var AHeight: Integer); {$IFDEF DELPHI6}virtual{$ELSE}override{$ENDIF};
    procedure ListMeasureWidth(const Value: string; ACanvas: TCanvas;
      var AWidth: Integer); {$IFDEF DELPHI6}virtual{$ELSE}override{$ENDIF};
    procedure ListDrawValue(const Value: string; ACanvas: TCanvas;
      const ARect: TRect; ASelected: Boolean); {$IFDEF DELPHI6}virtual{$ELSE}override{$ENDIF};
  end;

  { TcxStyleControllerStyleProperty }

  TcxStyleControllerStyleProperty = class(TClassProperty)
  private
    FProc: {$IFNDEF DELPHI6}TGetPropEditProc{$ELSE}TGetPropProc{$ENDIF};
    procedure GetPropProc({$IFNDEF DELPHI6}Prop: TPropertyEditor{$ELSE}const Prop: IProperty{$ENDIF});
  protected
    function GetStyle: TcxContainerStyle; virtual;
    function IsPropertyVisible(const APropertyName: string): Boolean; virtual;
  public
    procedure GetProperties(Proc: {$IFNDEF DELPHI6}TGetPropEditProc{$ELSE}TGetPropProc{$ENDIF}); override;
  end;

procedure ObjectInspectorCollapseProperty;

implementation

uses
{$IFDEF DELPHI6}
    DesignConst,
{$ELSE}
  Consts,
{$ENDIF}
  cxClasses;

function EnumChildProc(WND: HWND; LParam: Integer): BOOL; stdcall
var
  AName: array[0..255] of Char;
const
  S: string = 'TPropSelection';
begin
  Result := True;
  if (GetClassName(WND, @AName[0], 255) <> 0) and (AName = S) then
  begin
    SendMessage(WND, WM_CHAR, $2D, $4A0001);
    InvalidateRect(WND, nil, True);
    SendMessage(GetParent(WND), WM_SIZE, 0, 0);
  end;
end;

function EnumWnd(WND: HWND; LParam: Integer): BOOL; stdcall;
begin
  Result := True;
  EnumChildWindows(WND, @EnumChildProc, 0);
end;

procedure ObjectInspectorCollapseProperty;
begin
  EnumWindows(@EnumWnd, 0);
end;

function cxNestedEventProperty_GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paSubProperties, paReadOnly, paRevertable];
end;

procedure cxNestedEventProperty_GetProperties(APropertyEditor: TPropertyEditor;
  AInstance: TPersistent; Proc: {$IFDEF DELPHI6}TGetPropProc{$ELSE}TGetPropEditProc{$ENDIF});
var
  APropList: TPropList;
  I, ACount : Integer;
  AClassType: TClass;
begin
  if AInstance = nil then Exit;
  ACount := GetPropList(AInstance.ClassInfo, [tkMethod], @APropList);
  for I := 0 to ACount - 1 do
    Proc(TcxNestedElementEventProperty.Create(APropertyEditor, APropList[I]));
  ACount := GetPropList(AInstance.ClassInfo, [tkClass], @APropList);
  for I := 0 to ACount - 1 do
  begin
    AClassType := GetTypeData(APropList[I].PropType^).ClassType;
    if not AClassType.InheritsFrom(TComponent) and AClassType.InheritsFrom(TPersistent) and
      (GetPropList(AClassType.ClassInfo, [tkMethod], nil) <> 0) then
      Proc(TcxNestedParentElementEventProperty.Create(APropertyEditor, AInstance, APropList[I]));
  end;
end;

function cxNestedEventProperty_GetValue(AInstance: TPersistent): string;
begin
  if AInstance = nil then
    Result := '(None)'
  else
    Result := '(' + AInstance.ClassName + ')';
end;

{ TcxNestedEventProperty }

function TcxNestedEventProperty.GetAttributes: TPropertyAttributes;
begin
  Result := cxNestedEventProperty_GetAttributes;
end;

function TcxNestedEventProperty.GetName: string;
begin
  Result := inherited GetName;
  Result := Copy(Result, 1, Pos('Events', Result) - 1);
end;

procedure TcxNestedEventProperty.GetProperties(Proc: {$IFDEF DELPHI6}TGetPropProc{$ELSE}TGetPropEditProc{$ENDIF});
begin
  cxNestedEventProperty_GetProperties(Self, Instance, Proc);
end;

function TcxNestedEventProperty.GetValue: string;
begin
  Result := cxNestedEventProperty_GetValue(Instance);
end;

{ TcxNestedParentElementEventProperty }

constructor TcxNestedParentElementEventProperty.Create(Parent: TPropertyEditor;
  AOwner: TPersistent; APropInfo: PPropInfo);
begin
  inherited Create(Parent);
  FParent := Parent;
  FOwner := AOwner;
  FPropInfo := APropInfo;
end;

function TcxNestedParentElementEventProperty.GetInstance: TPersistent;
begin
  {$IFNDEF DELPHI5}
  Result := TPersistent(GetOrdProp(FOwner, FPropInfo))
  {$ELSE}
  Result := TPersistent(GetObjectProp(FOwner, FPropInfo));
  {$ENDIF}
end;

function TcxNestedParentElementEventProperty.GetAttributes: TPropertyAttributes;
begin
  Result := cxNestedEventProperty_GetAttributes;
end;

procedure TcxNestedParentElementEventProperty.GetProperties(Proc: {$IFDEF DELPHI6}TGetPropProc{$ELSE}TGetPropEditProc{$ENDIF});
begin
  cxNestedEventProperty_GetProperties(Self, Instance, Proc);
end;

function TcxNestedParentElementEventProperty.GetValue: string;
begin
  Result := cxNestedEventProperty_GetValue(Instance);
end;

function TcxNestedParentElementEventProperty.GetName: string;
begin
  Result := FPropInfo.Name;
end;

{ TNestedElementEventProperty }
constructor TcxNestedElementEventProperty.Create(Parent: TPropertyEditor; APropInfo: PPropInfo);
begin
  inherited Create(Parent);
  FPropInfo := APropInfo;
  FParent := Parent;
end;

function TcxNestedElementEventProperty.AllEqual: Boolean;
var