cxpropeditors.pas

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

  I: Integer;
  V, T: TMethod;
begin
  Result := False;
  if PropCount > 1 then
  begin
    V := GetMethodValue;
    for I := 1 to PropCount - 1 do
    begin
      T := GetMethodValueAt(I);
      if (T.Code <> V.Code) or (T.Data <> V.Data) then Exit;
    end;
  end;
  Result := True;
end;

procedure TcxNestedElementEventProperty.Edit;
var
  FormMethodName: string;
begin
  FormMethodName := GetValue;
  if (FormMethodName = '') or
    Designer.MethodFromAncestor(GetMethodValue) then
  begin
    if FormMethodName = '' then
      FormMethodName := GetFormMethodName;
    if FormMethodName = '' then
      raise EPropertyError.Create(SCannotCreateName);
    SetValue(FormMethodName);
  end;
  Designer.ShowMethod(FormMethodName);
end;

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

function TcxNestedElementEventProperty.GetEditLimit: Integer;
begin
  Result := MaxIdentLength;
end;

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

function TcxNestedElementEventProperty.GetValue: string;
begin
  Result := Designer.GetMethodName(GetMethodProp(Instance, FPropInfo));
end;

procedure TcxNestedElementEventProperty.GetValues(Proc: TGetStrProc);
begin
  Designer.GetMethods(GetTypeData(FPropInfo.PropType^), Proc);
end;

procedure TcxNestedElementEventProperty.SetValue(const AValue: string);

  {$IFDEF DELPHI5}
  procedure CheckChainCall(const MethodName: string; Method: TMethod);
  var
    Persistent: TPersistent;
    Component: TComponent;
    InstanceMethod: string;
    Instance: TComponent;
  begin
    Persistent := GetComponent(0);
    if Persistent is TComponent then
    begin
      Component := TComponent(Persistent);
      if (Component.Name <> '') and (Method.Data <> Designer.GetRoot) and
        (TObject(Method.Data) is TComponent) then
      begin
        Instance := TComponent(Method.Data);
        InstanceMethod := Instance.MethodName(Method.Code);
        if InstanceMethod <> '' then
          Designer.ChainCall(MethodName, Instance.Name, InstanceMethod,
            GetTypeData(GetPropType));
      end;
    end;
  end;
  {$ENDIF}
var
  NewMethod: Boolean;
  CurValue: string;
  OldMethod: TMethod;
begin
  CurValue:= GetValue;
  if (CurValue <> '') and (AValue <> '') and ((CompareText(CurValue, AValue) = 0) or
    not Designer.MethodExists(AValue)) and not Designer.MethodFromAncestor(GetMethodValue) then
    Designer.RenameMethod(CurValue, AValue)
  else
  begin
    NewMethod := (AValue <> '') and not Designer.MethodExists(AValue);
    OldMethod := GetMethodValue;
    SetMethodProp(Instance, FPropInfo,
      Designer.CreateMethod(AValue, GetTypeData(FPropInfo.PropType^)));
    if NewMethod then
    begin
      {$IFDEF DELPHI5}
      if (PropCount = 1) and (OldMethod.Data <> nil) and (OldMethod.Code <> nil) then
        CheckChainCall(AValue, OldMethod);
      {$ENDIF}  
      Designer.ShowMethod(AValue);
    end;
    Designer.Modified; 
  end;
end;

function TcxNestedElementEventProperty.GetFormMethodName: string;
var
  I: Integer;
begin
  if GetComponent(0) = Designer.GetRoot then
  begin
    {$IFNDEF DELPHI5}
    if Designer.GetRoot <> nil then
      Result := Designer.GetRoot.ClassName
    else Result := '';  
    {$ELSE}
    Result := Designer.GetRootClassName;
    {$ENDIF}
    if (Result <> '') and (Result[1] = 'T') then
      Delete(Result, 1, 1);
  end
  else
  begin
    Result := Designer.GetObjectName(GetComponent(0));
    for I := Length(Result) downto 1 do
      if Result[I] in ['.','[',']','-','>'] then
        Delete(Result, I, 1);
  end;
  if Result = '' then
    raise EPropertyError.Create(SCannotCreateName);
  Result := Result + GetPersistentClassNames + GetTrimmedEventName;
end;

function TcxNestedElementEventProperty.GetTrimmedEventName: string;
begin
  Result := GetName;
  if (Length(Result) >= 2) and (Result[1] in ['O', 'o']) and
    (Result[2] in ['N', 'n']) then
    Delete(Result, 1, 2);
end;

function TcxNestedElementEventProperty.GetPersistentClassNames: string;
var
  APropertyEditor: TPropertyEditor;
begin
  Result := '';
  APropertyEditor := self;
  while APropertyEditor <> nil do
  begin
    if APropertyEditor is TcxNestedParentElementEventProperty then
      APropertyEditor := TcxNestedParentElementEventProperty(APropertyEditor).FParent
    else
      if APropertyEditor is TcxNestedElementEventProperty then
        APropertyEditor := TcxNestedElementEventProperty(APropertyEditor).FParent
      else APropertyEditor := nil;
    if APropertyEditor <> nil then
      Result := APropertyEditor.GetName + Result;
  end;
end;

function TcxNestedElementEventProperty.GetInstance: TPersistent;
begin
  Result := nil;
  if FParent is TcxNestedEventProperty then
    Result := TcxNestedEventProperty(FParent).Instance;
  if FParent is TcxNestedParentElementEventProperty then
    Result := TcxNestedParentElementEventProperty(FParent).Instance;
end;

{ TImageIndexProperty }

function TImageIndexProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paValueList, paRevertable];
end;

function TImageIndexProperty.GetValue: string;
begin
  Result := IntToStr(GetOrdValue);
end;

procedure TImageIndexProperty.GetValues(Proc: TGetStrProc);
var
  I: Integer;
begin
  Proc('-1');
  if GetImages <> nil then
    for I := 0 to GetImages.Count - 1 do Proc(IntToStr(I));
end;

procedure TImageIndexProperty.ListDrawValue(const Value: string;
  ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
var
  AImageWidth: Integer;
begin
  with ACanvas do
  begin
    if GetImages <> nil then
    begin
      FillRect(ARect);
      if ASelected then DrawFocusRect(ARect);
      AImageWidth := GetImages.Width + 2 * 2;
      GetImages.Draw(ACanvas, ARect.Left + 2,
        (ARect.Top + ARect.Bottom - GetImages.Height) div 2, StrToInt(Value));
    end
    else
      AImageWidth := 0;
    TextOut(ARect.Left + AImageWidth + 2,
      (ARect.Top + ARect.Bottom - TextHeight(Value)) div 2, Value);
  end;
end;

procedure TImageIndexProperty.ListMeasureHeight(const Value: string;
  ACanvas: TCanvas; var AHeight: Integer);
var
  AImageHeight, AStringHeight: Integer;
begin
  if GetImages <> nil then
    AImageHeight := GetImages.Height + 2 * 2
  else
    AImageHeight := 0;
  AStringHeight := ACanvas.TextHeight(Value);
  if AStringHeight > AImageHeight then
    AHeight := AStringHeight
  else
    AHeight := AImageHeight;
end;

procedure TImageIndexProperty.ListMeasureWidth(const Value: string;
  ACanvas: TCanvas; var AWidth: Integer);
var
  AImageWidth, AStringWidth: Integer;
begin
  if GetImages <> nil then
    AImageWidth  := GetImages.Width + 2 * 2
  else
    AImageWidth := 0;
  AStringWidth := ACanvas.TextWidth(Value) + 2 * 2;
  AWidth := AImageWidth + AStringWidth;
end;

procedure TImageIndexProperty.SetValue(const Value: string);
begin
  SetOrdValue(StrToInt(Value));
end;

{ TcxStyleControllerStyleProperty }

procedure TcxStyleControllerStyleProperty.GetProperties(
  Proc: {$IFNDEF DELPHI6}TGetPropEditProc{$ELSE}TGetPropProc{$ENDIF});
begin
  FProc := Proc;
  inherited GetProperties(GetPropProc);
end;

function TcxStyleControllerStyleProperty.GetStyle: TcxContainerStyle;
begin
  Result := TcxStyleController(GetComponent(0)).Styles[csNormal];
end;

function TcxStyleControllerStyleProperty.IsPropertyVisible(
  const APropertyName: string): Boolean;
begin
  Result := not((GetName <> 'Style') and
    not GetStyle.IsExtendedStylePropertyPublished(APropertyName));
end;

procedure TcxStyleControllerStyleProperty.GetPropProc(
  {$IFNDEF DELPHI6}Prop: TPropertyEditor{$ELSE}const Prop: IProperty{$ENDIF});
begin
  if IsPropertyVisible(Prop.GetName) then
    FProc(Prop);
end;

end.