cxeditpropeditors.pas

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

uses
  SysUtils, cxButtons, cxClasses, cxControls, cxEditMaskEditor,
  cxEditRepositoryEditor, cxImage, cxImageComboBox, cxListBox, cxMaskEdit,
  cxMaskEditTextEditor, cxNavigator, cxRadioGroup;

const
  cxEditComponentEditorVerbA: array[0..1] of string = (
    'Restore properties',
    'Restore styles');

  cxEditRepositoryEditorVerb = 'Edit...';

  cxCustomEditControlEditorVerbA: array[0..1] of string = (
    'Restore LookAndFeel',
    'Restore Styles'
  );

  cxCustomNavigatorEditorVerb = 'Restore Buttons';

  ADefaultMethodParams: array[0..0] of TMethodParam =
    ((Flags: [pfAddress]; Name: 'Sender'; TypeName: 'TObject'));

  cxNavigatorButtonsOnButtonClickEventParams: array[0..2] of TMethodParam = (
    (Flags: [pfAddress]; Name: 'Sender'; TypeName: 'TObject'),
    (Flags: [pfAddress]; Name: 'AButtonIndex'; TypeName: 'Integer'),
    (Flags: [pfVar]; Name: 'ADone'; TypeName: 'Boolean')
  );

type
  TcxCustomEditAccess = class(TcxCustomEdit);
  TcxCustomEditPropertiesAccess = class(TcxCustomEditProperties);
  TcxCustomMaskEditPropertiesAccess = class(TcxCustomMaskEditProperties);
  TcxCustomNavigatorAccess = class(TcxCustomNavigator);

procedure AddMethodParam(var P: PChar; AParamFlags: TParamFlags;
  const AParamName, AParamTypeName: ShortString);
var
  AMethodParamFlags: TParamFlags;
  S: ShortString;
begin
  AMethodParamFlags := AParamFlags;
  Move(AMethodParamFlags, P^, SizeOf(AMethodParamFlags));
  Inc(P, SizeOf(AMethodParamFlags));
  S := AParamName;
  Move(S[0], P^, Length(S) + 1);
  Inc(P, Length(S) + 1);
  S := AParamTypeName;
  Move(S[0], P^, Length(S) + 1);
  Inc(P, Length(S) + 1);
end;

procedure ShowEventMethod(
  ADesigner: IDesigner;
  AInstance: TObject; const AEventName, AMethodName: string;
  const AMethodParams: array of TMethodParam);

  function GetCurrentMethod: string;
  var
    ACurrentMethod: TMethod;
  begin
{$IFDEF DELPHI5}
    ACurrentMethod := GetMethodProp(AInstance, AEventName);
{$ELSE}
    ACurrentMethod := GetMethodProp(AInstance,
      GetPropInfo(PTypeInfo(AInstance.ClassInfo), AEventName));
{$ENDIF}
    if ACurrentMethod.Code = nil then
      Result := ''
    else
      Result := ADesigner.GetMethodName(ACurrentMethod);
  end;

  function CreateNewMethod: string;
  var
    AMethod: TMethod;
    ATypeData: TTypeData;
    I: Integer;
    P: PChar;
  begin
    Result := AMethodName;

    ATypeData.MethodKind := mkProcedure;
    ATypeData.ParamCount := Length(AMethodParams);
    P := @ATypeData.ParamList;
    for I := 0 to High(AMethodParams) do
      with AMethodParams[I] do
        AddMethodParam(P, Flags, Name, TypeName);
    AMethod := ADesigner.CreateMethod(AMethodName, @ATypeData);

  {$IFDEF DELPHI5}
    SetMethodProp(AInstance, AEventName, AMethod);
  {$ELSE}
    SetMethodProp(AInstance, GetPropInfo(PTypeInfo(AInstance.ClassInfo),
      AEventName), AMethod);
  {$ENDIF}
    ADesigner.Modified;
  end;

var
  S: string;
begin
  S := GetCurrentMethod;
  if S = '' then
    S := CreateNewMethod;
  ADesigner.ShowMethod(S);
end;

{ TDBStringProperty }

function TDBStringProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paValueList, paSortList, paMultiSelect];
end;

procedure TDBStringProperty.GetValueList(AList: TStrings);
begin
end;

procedure TDBStringProperty.GetValues(Proc: TGetStrProc);
var
  I: Integer;
  Values: TStringList;
begin
  Values := TStringList.Create;
  try
    GetValueList(Values);
    for I := 0 to Values.Count - 1 do Proc(Values[I]);
  finally
    Values.Free;
  end;
end;

{$IFDEF CBUILDER10}

{ TcxDataFieldProperty }

function TcxDataFieldProperty.GetDataSourcePropName: string;
begin
  Result := 'DataSource';
end;

procedure TcxDataFieldProperty.GetValueList(AList: TStrings);
var
  DataSource: TDataSource;
begin
  DataSource := GetObjectProp(GetComponent(0), GetDataSourcePropName) as TDataSource;
  if (DataSource <> nil) and (DataSource.DataSet <> nil) then
    DataSource.DataSet.GetFieldNames(AList);
end;

{$ENDIF}

{ TcxValueTypeProperty }

function TcxValueTypeProperty.IsValueTypeClassValid(AValueTypeClass: TcxValueTypeClass): Boolean;
begin
  Result := True;
end;

function TcxValueTypeProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paValueList, paMultiSelect, paSortList, paRevertable];
end;

procedure TcxValueTypeProperty.GetValues(Proc: TGetStrProc);
var
  I: Integer;
begin
  for I := 0 to cxValueTypeClassList.Count - 1 do
    if IsValueTypeClassValid(cxValueTypeClassList[I]) then
      Proc(cxValueTypeClassList[I].Caption);
end;

{$IFNDEF DELPHI5}

// TODO: cxDBData.pas (GetObjectProp already exist)
function GetObjectProp(Instance: TObject; const PropName: string): TObject;
var
  PropInfo: PPropInfo;
begin
  Result := nil;
  PropInfo := TypInfo.GetPropInfo(Instance.ClassInfo, PropName);
  if (PropInfo <> nil) and (PropInfo^.PropType^.Kind = tkClass) then
    Result := TObject(GetOrdProp(Instance, PropInfo));
end;

{$ENDIF}

function TFieldNameProperty.GetDataSource: TDataSource;
begin
  Result := GetObjectProp(GetComponent(0), GetDataSourcePropName) as TDataSource;
end;

function TFieldNameProperty.GetDataSourcePropName: string;
begin
  Result := 'DataSource';
end;

procedure TFieldNameProperty.GetValueList(AList: TStrings);
var
  ADataSource: TDataSource;
begin
  ADataSource := GetDataSource;
  if (ADataSource <> nil) and (ADataSource.DataSet <> nil) then
    ADataSource.DataSet.GetFieldNames(AList);
end;

{ TcxCustomEditorsLibraryComponentEditor }

function TcxCustomEditorsLibraryComponentEditor.GetProductMajorVersion: string;
begin
  Result := cxEditPropEditorsMajorVersion;
end;

function TcxCustomEditorsLibraryComponentEditor.GetProductName: string;
begin
  Result := cxEditorsLibraryProductName;
end;

{ TcxEditComponentEditor }

procedure TcxEditComponentEditor.Edit;
var
  AEdit: TcxCustomEdit;
  AEventName: string;
  AInstance: TObject;
  AMethodName: string;
  AProperties: TcxCustomEditProperties;
begin
  AEdit := TcxCustomEdit(Component);
  AMethodName := Component.Name;
  if not(AEdit.InnerControl <> nil) and
    (GetPropInfo(PTypeInfo(AEdit.ClassInfo), 'OnClick') <> nil) then
  begin
    AMethodName := AMethodName + 'Click';
    AInstance := AEdit;
    AEventName := 'OnClick';
  end
  else
  begin
    AProperties := TcxCustomEditAccess(AEdit).Properties;
    if GetPropInfo(PTypeInfo(AProperties.ClassInfo), 'OnChange') <> nil then
    begin
      AMethodName := AMethodName + 'PropertiesChange';
      AInstance := AProperties;
      AEventName := 'OnChange';
    end
    else
      Exit;
  end;

  ShowEventMethod(Designer, AInstance, AEventName, AMethodName, ADefaultMethodParams);
end;

function TcxEditComponentEditor.InternalGetVerb(Index: Integer): string;
begin
  Result := cxEditComponentEditorVerbA[Index];
end;

function TcxEditComponentEditor.InternalGetVerbCount: Integer;
begin
  Result := Length(cxEditComponentEditorVerbA);
end;

procedure TcxEditComponentEditor.InternalExecuteVerb(AIndex: Integer);
begin
  case AIndex of
    0:
      TcxCustomEditAccess(GetEdit).Properties.RestoreDefaults;
    1:
      GetEdit.RestoreStyles;
  end;
  Designer.Modified;
end;

function TcxEditComponentEditor.GetEdit: TcxCustomEdit;
begin
  Result := Component as TcxCustomEdit;
end;

{ TcxEditRepositoryItemProperty }

function TcxEditRepositoryItemProperty.GetAttributes: TPropertyAttributes;
begin
  Result := inherited GetAttributes;
  {$IFDEF DELPHI6}
  if TcxCustomEdit(GetComponent(0)).RepositoryItem <> nil then
    Include(Result, paNotNestable);
  {$ENDIF}
end;

procedure TcxEditRepositoryItemProperty.GetValues(Proc: TGetStrProc);
begin
  FStrProc := Proc;
  Designer.GetComponentNames(GetTypeData(GetPropType), StrProc);
end;

procedure TcxEditRepositoryItemProperty.StrProc(const S: string);
var
  I: Integer;
  ARepositoryItemAcceptable: Boolean;
begin
  ARepositoryItemAcceptable := True;
  for I := 0 to PropCount - 1 do
  if not TcxCustomEdit(GetComponent(I)).IsRepositoryItemAcceptable(
    TcxEditRepositoryItem(Designer.GetComponent(S))) then
  begin
    ARepositoryItemAcceptable := False;
    Break;
  end;
  if ARepositoryItemAcceptable then
    FStrProc(S);
end;

{ TcxLookupEditListSourceProperty }

function TcxLookupEditListSourceProperty.GetDataSourcePropName: string;
begin
  Result := 'ListSource';
end;

{ TcxEditPropertiesEventEditor }

function TcxEditPropertiesEventEditor.GetName: string;
begin
  Result := 'Properties';
end;

function TcxEditPropertiesEventEditor.GetInstance: TPersistent;
begin
  Result := TcxCustomEditAccess(GetComponent(0)).Properties;
end;

{ TcxEditRepositoryItemPropertiesEventEditor }

function TcxEditRepositoryItemPropertiesEventEditor.GetName: string;
begin
  Result := 'Properties';
end;

function TcxEditRepositoryItemPropertiesEventEditor.GetInstance: TPersistent;
begin
  Result := TcxEditRepositoryItem(GetComponent(0)).Properties;
end;

{ TcxNavigatorButtonsEventEditor }

function TcxNavigatorButtonsEventEditor.GetName: string;
begin
  Result := 'Buttons';
end;

function TcxNavigatorButtonsEventEditor.GetInstance: TPersistent;
begin
  Result := TcxCustomNavigatorAccess(GetComponent(0)).CustomButtons;
end;

{ TcxGEPropertiesImageIndexProperty }

function TcxGEPropertiesImageIndexProperty.GetImages: TCustomImageList;
begin
  Result := nil;
  if GetComponent(0) is TcxImageComboBoxProperties then
    Result := TcxImageComboBoxProperties(GetComponent(0)).Images;
end;

{ TcxGEItemImageIndexProperty }

function TcxGEItemImageIndexProperty.GetImages: TCustomImageList;
begin
  Result := nil;
  if GetComponent(0) is TcxImageComboBoxItem then
  begin
    Result := TcxImageComboBoxProperties(TcxImageComboBoxItems(
      TcxImageComboBoxItem(GetComponent(0)).Collection).Owner).LargeImages;
    if Result = nil then
      Result := TcxImageComboBoxProperties(TcxImageComboBoxItems(
        TcxImageComboBoxItem(GetComponent(0)).Collection).Owner).Images;
  end;
end;

{ TcxEditorsLibraryComponentEditorEx }

function TcxEditorsLibraryComponentEditorEx.GetEditItemcaption: string;
begin
  Result := cxEditRepositoryEditorVerb;
end;

function TcxEditorsLibraryComponentEditorEx.InternalGetVerb(AIndex: Integer): string;
begin
  Result := GetEditItemCaption;
end;

function TcxEditorsLibraryComponentEditorEx.InternalGetVerbCount: Integer;
begin