dsgnintf.pas

Motorola 集群通信系统中SDTS车载台PEI端测试程序

  that would be TIntegerProperty). Most properties do not need specialized
  property editors.  For example, if the property is an ordinal type the
  default property editor will restrict the range to the ordinal subtype
  range (e.g. a property of type TMyRange = 1..10 will only allow values
  between 1 and 10 to be entered into the property).  Enumerated types will
  display a drop-down list of all the enumerated values (e.g. TShapes =
  (sCircle, sSquare, sTriangle) will be edited by a drop-down list containing
  only sCircle, sSquare and sTriangle).  A property editor need only be
  created if default property editor or none of the existing property editors
  are sufficient to edit the property.  This is typically because the
  property is an object.  The properties are looked up newest to oldest.
  This allows and existing property editor replaced by a custom property
  editor.

    PropertyType
      The type information pointer returned by the TypeInfo built-in function
      (e.g. TypeInfo(TMyRange) or TypeInfo(TShapes)).

    ComponentClass
      Type type of the component to which to restrict this type editor.  This
      parameter can be left nil which will mean this type editor applies to all
      properties of PropertyType.

    PropertyName
      The name of the property to which to restrict this type editor.  This
      parameter is ignored if ComponentClass is nil.  This paramter can be
      an empty string ('') which will mean that this editor applies to all
      properties of PropertyType in ComponentClass.

    EditorClass
      The class of the editor to be created whenever a property of the type
      passed in PropertyTypeInfo is displayed in the Object Inspector.  The
      class will be created by calling EditorClass.Create. }

procedure RegisterPropertyEditor(PropertyType: PTypeInfo; ComponentClass: TClass;
  const PropertyName: string; EditorClass: TPropertyEditorClass);

type
  TPropertyMapperFunc = function(Obj: TPersistent;
    PropInfo: PPropInfo): TPropertyEditorClass;

procedure RegisterPropertyMapper(Mapper: TPropertyMapperFunc);

procedure GetComponentProperties(Components: TComponentList;
  Filter: TTypeKinds; Designer: IFormDesigner; Proc: TGetPropEditProc);

procedure RegisterComponentEditor(ComponentClass: TComponentClass;
  ComponentEditor: TComponentEditorClass);

function GetComponentEditor(Component: TComponent;
  Designer: IFormDesigner): TComponentEditor;

{ Custom modules }
{ A custom module allows containers that descend from classes other than TForm
  to be created and edited by the form designer. This is useful for other form
  like containers (e.g. a report designer) or for specialized forms (e.g. an
  ActiveForm) or for generic component containers (e.g. a TDataModule). It is
  assumed that the base class registered will call InitInheritedComponent in its
  constructor which will initialize the component from the associated DFM file
  stored in the programs resources. See the constructors of TDataModule and
  TForm for examples of how to write such a constructor.

  The following designer assumptions are made, depending on the base components
  ancestor,

    If ComponentBaseClass descends from TForm,

       it is designed by creating an instance of the component as the form.
       Allows designing TForm descendents and modifying their properties as
       well as the form properties

    If ComponentBaseClass descends from TWinControl (but not TForm),

       it is designed by creating an instance of the control, placing it into a
       design-time form.  The form's client size is in the default size of the
       control.

    If ComponentBaseClass descends from TDataModule,

       it is designed by creating and instance of the class and creating a
       special non-visual container designer to edit the components and display
       the icons of the contained components.

  The module will appear in the project file with a colon and the base class
  name appended after the component name (e.g. MyDataModle: TDataModule).

  Note it is not legal to register anything that does not desend from one of
  the above.

  TCustomModule class
    This an instance of this class is created for each custom module that is
    loaded. This class is also destroyed whenever the module is unloaded.
    The Saving method is called prior to the file being saved. When the context
    menu for the module is invoked the GetVerbCount and GetVerb methods are
    called to build the menu.  If one of the verbs are selected ExecuteVerb is
    called.

    ExecuteVerb(Index)
      The Index'ed verb was selected by the use off the context menu.  The
      meaning of this is determined by custom module.
    GetAttributes
      Only used for TWinControl object to determine if the control is "client
      aligned" in the designer or if the object should sized independently
      from the designer.  This is a set for future expansion.
    GetVerb(Index)
      The custom module should return a string that will be displayed in the
      context menu.  It is the responsibility of the custom module to place
      the & character and the '...' characters as appropriate.
    GetVerbCount
      The number of valid indexs to GetVerb and Execute verb.  The index assumed
      to be zero based (i.e. 0..GetVerbCount - 1).
    Saving
      Called prior to the module being saved.
    ValidateComponent(Component)
      ValidateCompoennt is called whenever a component is created by the
      user for the designer to contain.  The intent is for this procedure to
      raise an exception with a descriptive message if the component is not
      applicable for the container. For example, a TComponent module should
      throw an exception if the component descends from TControl.
    Root
      This is the instance being designed.}

type
  TCustomModuleAttribute = (cmaVirtualSize);
  TCustomModuleAttributes = set of TCustomModuleAttribute;

  TCustomModule = class
  private
    FRoot: IComponent;
  public
    constructor Create(ARoot: IComponent); virtual;
    procedure ExecuteVerb(Index: Integer); virtual;
    function GetAttributes: TCustomModuleAttributes; virtual;
    function GetVerb(Index: Integer): string; virtual;
    function GetVerbCount: Integer; virtual;
    procedure Saving; virtual;
    procedure ValidateComponent(Component: IComponent); virtual;
    property Root: IComponent read FRoot;
  end;

  TCustomModuleClass = class of TCustomModule;

  TRegisterCustomModuleProc = procedure (Group: Integer;
    ComponentBaseClass: TComponentClass;
    CustomModuleClass: TCustomModuleClass);

procedure RegisterCustomModule(ComponentBaseClass: TComponentClass;
  CustomModuleClass: TCustomModuleClass);

var
  RegisterCustomModuleProc: TRegisterCustomModuleProc;

{ Routines used by the form designer for package management }

function NewEditorGroup: Integer;
procedure FreeEditorGroup(Group: Integer);

var  // number of significant characters in identifiers
  MaxIdentLength: Byte = 63;

implementation

uses Menus, Dialogs, Consts, Registry;

type
  TIntegerSet = set of 0..SizeOf(Integer) * 8 - 1;

type
  PPropertyClassRec = ^TPropertyClassRec;
  TPropertyClassRec = record
    Group: Integer;
    PropertyType: PTypeInfo;
    PropertyName: string;
    ComponentClass: TClass;
    EditorClass: TPropertyEditorClass;
  end;

type
  PPropertyMapperRec = ^TPropertyMapperRec;
  TPropertyMapperRec = record
    Group: Integer;
    Mapper: TPropertyMapperFunc;
  end;

const
  PropClassMap: array[TTypeKind] of TPropertyEditorClass = (
    nil, TIntegerProperty, TCharProperty, TEnumProperty,
    TFloatProperty, TStringProperty, TSetProperty, TClassProperty,
    TMethodProperty, TPropertyEditor, TStringProperty, TStringProperty,
    TPropertyEditor, nil, nil, nil, nil, nil); (* tkArray, tkRecord, kInterface, tkInt64, tkDynArray *)

var
  PropertyClassList: TList = nil;
  EditorGroupList: TBits = nil;
  PropertyMapperList: TList = nil;

const

  { context ids for the Font editor and the Color Editor, etc. }
  hcDFontEditor       = 25000;
  hcDColorEditor      = 25010;
  hcDMediaPlayerOpen  = 25020;

{ TComponentList }

constructor TComponentList.Create;
begin
  inherited Create;
  FList := TList.Create;
end;

destructor TComponentList.Destroy;
begin
  FList.Free;
  inherited Destroy;
end;

function TComponentList.Get(Index: Integer): TPersistent;
begin
  Result := FList[Index];
end;

function TComponentList.GetCount: Integer;
begin
  Result := FList.Count;
end;

function TComponentList.Add(Item: TPersistent): Integer;
begin
  Result := FList.Add(Item);
end;

function TComponentList.Equals(List: TComponentList): Boolean;
var
  I: Integer;
begin
  Result := False;
  if List.Count <> FList.Count then Exit;
  for I := 0 to List.Count - 1 do if List[I] <> FList[I] then Exit;
  Result := True;
end;

function TComponentList.Intf_Add(const Item: IPersistent): Integer;
begin
  Result := Add(ExtractPersistent(Item));
end;

function TComponentList.Intf_Equals(const List: IDesignerSelections): Boolean;
var
  I: Integer;
  CompList: IComponentList;
  P1, P2: IPersistent;
begin
  if List.QueryInterface(IComponentList, CompList) = 0 then
    Result := CompList.GetComponentList.Equals(Self)
  else
  begin
    Result := False;
    if List.Count <> FList.Count then Exit;
    for I := 0 to List.Count - 1 do
    begin
      P1 := Intf_Get(I);
      P2 := List[I];
      if ((P1 = nil) and (P2 <> nil)) or
        (P2 = nil) or not P1.Equals(P2) then Exit;
    end;
    Result := True;
  end;
end;

function TComponentList.Intf_Get(Index: Integer): IPersistent;
begin
  Result := MakeIPersistent(TPersistent(FList[Index]));
end;

function TComponentList.GetComponentList: TComponentList;
begin
  Result := Self;
end;

{ TPropertyEditor }

constructor TPropertyEditor.Create(const ADesigner: IFormDesigner;
  APropCount: Integer);
begin
  FDesigner := ADesigner;
  GetMem(FPropList, APropCount * SizeOf(TInstProp));
  FPropCount := APropCount;
end;

destructor TPropertyEditor.Destroy;
begin
  if FPropList <> nil then
    FreeMem(FPropList, FPropCount * SizeOf(TInstProp));
end;

procedure TPropertyEditor.Activate;
begin
end;

function TPropertyEditor.AllEqual: Boolean;
begin
  Result := FPropCount = 1;
end;

procedure TPropertyEditor.Edit;
type
  TGetStrFunc = function(const Value: string): Integer of object;
var
  I: Integer;
  Values: TStringList;
  AddValue: TGetStrFunc;
begin
  Values := TStringList.Create;
  Values.Sorted := paSortList in GetAttributes;
  try
    AddValue := Values.Add;
    GetValues(TGetStrProc(AddValue));
    if Values.Count > 0 then
    begin
      I := Values.IndexOf(Value) + 1;
      if I = Values.Count then I := 0;
      Value := Values[I];
    end;
  finally
    Values.Free;
  end;
end;

function TPropertyEditor.AutoFill: Boolean;
begin
  Result := True;
end;

function TPropertyEditor.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paRevertable];
end;

function TPropertyEditor.GetComponent(Index: Integer): TPersistent;
begin
  Result := FPropList^[Index].Instance;
end;

function TPropertyEditor.GetFloatValue: Extended;
begin
  Result := GetFloatValueAt(0);
end;

function TPropertyEditor.GetFloatValueAt(Index: Integer): Extended;
begin
  with FPropList^[Index] do Result := GetFloatProp(Instance, PropInfo);
end;

function TPropertyEditor.GetMethodValue: TMethod;
begin
  Result := GetMethodValueAt(0);
end;

function TPropertyEditor.GetMethodValueAt(Index: Integer): TMethod;
begin
  with FPropList^[Index] do Result := GetMethodProp(Instance, PropInfo);
end;

function TPropertyEditor.GetEditLimit: Integer;
begin
  Result := 255;
end;

function TPropertyEditor.GetName: string;
begin
  Result := FPropList^[0].PropInfo^.Name;
end;

function TPropertyEditor.GetOrdValue: Longint;
begin
  Result := GetOrdValueAt(0);
end;

function TPropertyEditor.GetOrdValueAt(Index: Integer): Longint;
begin
  with FPropList^[Index] do Result := GetOrdProp(Instance, PropInfo);
end;

function TPropertyEditor.GetPrivateDirectory: string;
begin
  Result := Designer.GetPrivateDirectory;
end;

procedure TPropertyEditor.GetProperties(Proc: TGetPropEditProc);
begin
end;

function TPropertyEditor.GetPropInfo: PPropInfo;
begin
  Result := FPropList^[0].PropInfo;
end;

function TPropertyEditor.GetPropType: PTypeInfo;
begin
  Result := FPropList^[0].PropInfo^.PropType^;
end;

function TPropertyEditor.GetStrValue: string;
begin