cxlibraryreg.pas

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

    FImageLists := TStringList.Create;
    try
      Designer.GetComponentNames(GetTypeData(TCustomImageList.ClassInfo), CheckImageListForImport);
      if cxEditImageList(ImageList, FImageLists) then
        Designer.Modified;
    finally
      FreeAndNil(FImageLists);
    end;
  end;

begin
  if (Index = 0) then
    Edit
  else
    inherited
end;

function TcxImageListComponentEditor.GetVerb(Index: Integer): string;
begin
  if Index = 0 then
    Result := 'Edit...'
  else
    if (Index = 1) and (FAssignableImageLists.Count > 0) then
      Result := 'Assign From'
    else
    Result := inherited GetVerb(Index);
end;

function TcxImageListComponentEditor.GetVerbCount: Integer;
var
  ACount: Integer;
begin
  ACount := 1;
  UpdateAssignableList;
  if FAssignableImageLists.Count > 0 then
    Inc(ACount);
  Result := ACount + inherited GetVerbCount;
end;

procedure TcxImageListComponentEditor.PrepareItem(Index: Integer;
  const AItem: TDesignMenuItem);
var
  I: Integer;

{$IFNDEF DELPHI6}
  function CreateMenuItem(const ACaption: string): TMenuItem;
  begin
    Result := TMenuItem.Create(AItem.Owner);
    with Result do
    begin
      Caption := ACaption;
      Checked := False;
      OnClick := AssignClick;
    end;
  end;
{$ENDIF}

begin
  inherited;
  if (FAssignableImageLists.Count > 0) and (Index = 1) then
  begin
    for I := 0 to FAssignableImageLists.Count - 1 do
    {$IFDEF DELPHI6}
      AItem.AddItem(FAssignableImageLists[I], 0, False, True, AssignClick);
    {$ELSE}
      AItem.Add(CreateMenuItem(FAssignableImageLists[I]));
    {$ENDIF}
  end;
end;

function TcxImageListComponentEditor.GetImageList: TcxImageList;
begin
  Result := Component as TcxImageList;
end;

procedure TcxImageListComponentEditor.UpdateAssignableList;
begin
  FAssignableImageLists.Clear;
  Designer.GetComponentNames(GetTypeData(TCustomImageList.ClassInfo), CheckImageListForAssign);
end;

procedure TcxImageListComponentEditor.AssignClick(Sender: TObject);
var
  AImages: TCustomImageList;
begin
  AImages := FAssignableImageLists.Objects[((Sender as TMenuItem).MenuIndex)] as TCustomImageList;
  if AImages.Count > 0 then
  begin
    ImageList.Assign(AImages);
    if (AImages.ClassName = 'TPngImageList') and CheckGdiPlus then
    begin
      ImageList.Clear;
      PngImageListTocxImageList(AImages, ImageList);
    end;
    Designer.Modified;
  end;
end;

procedure TcxImageListComponentEditor.CheckAddImageList(
  const AImageListName: string; AList: TStringList);
var
  AImageList: TCustomImageList;
begin
  AImageList := TCustomImageList(Designer.GetComponent(AImageListName));
  if AImageList <> ImageList then
    AList.AddObject(AImageListName, AImageList);
end;

procedure TcxImageListComponentEditor.CheckImageListForImport(const AImageListName: string);
begin
  CheckAddImageList(AImageListName, FImageLists);
end;

procedure TcxImageListComponentEditor.CheckImageListForAssign(const AImageListName: string);
begin
  CheckAddImageList(AImageListName, FAssignableImageLists);
end;

{ TcxContainerStyleProperty }

procedure TcxContainerStyleProperty.GetProperties(Proc: TGetPropProc);
begin
  FProc := Proc;
  inherited GetProperties(GetPropProc);
end;

procedure TcxContainerStyleProperty.GetPropProc({$IFNDEF DELPHI6}Prop: TPropertyEditor{$ELSE}const Prop: IProperty{$ENDIF});
var
  I: Integer;
begin
  for I := 0 to PropCount - 1 do
    if not TcxContainer(GetComponent(I)).IsStylePropertyPublished(Prop.GetName, GetName <> 'Style') then
      Exit;
  FProc(Prop);
end;

{ TcxContainerStyleAssignedValuesProperty }

procedure TcxContainerStyleAssignedValuesProperty.GetProperties(Proc: TGetPropProc);
var
  AStyleValueList: TStringList;
  I, AValue: Integer;
begin
  AStyleValueList := TStringList.Create;
  try
    FillVisiblePropertiesList(AStyleValueList);
    for I := 0 to AStyleValueList.Count - 1 do
    begin
      AValue := TcxContainerStyleValue(AStyleValueList.Objects[I]);
      Proc(TcxContainerStyleAssignedValuesElementProperty.Create(Self, AValue));
    end;
  finally
    AStyleValueList.Free;
  end;
end;

function TcxContainerStyleAssignedValuesProperty.GetValue: string;
var
  AStyleValues: TcxContainerStyleValues;
  AStyleValueList: TStringList;
  I: Integer;
begin
  Integer(AStyleValues) := GetOrdValue;
  Result := '';
  AStyleValueList := TStringList.Create;
  try
    FillVisiblePropertiesList(AStyleValueList);
    for I := 0 to AStyleValueList.Count - 1 do
      if TcxContainerStyleValue(AStyleValueList.Objects[I]) in AStyleValues then
        Result := Result + AStyleValueList[I] + ',';
    Delete(Result, Length(Result), 1);
    Result := '[' + Result + ']';
  finally
    AStyleValueList.Free;
  end;
end;

procedure TcxContainerStyleAssignedValuesProperty.FillVisiblePropertiesList(
  AList: TStringList);

  procedure FillStyleValueList(AStyle: TcxContainerStyle;
    AStyleValueList: TStringList);
  var
    APropertyCount, AStyleValueIndex, I: Integer;
    APPropList: PPropList;
    AStyleValue: TcxContainerStyleValue;
  begin
    APropertyCount := GetPropList(PTypeInfo(AStyle.ClassInfo), [tkUnknown..tkDynArray], nil);
    if APropertyCount = 0 then Exit;
    GetMem(APPropList, APropertyCount * SizeOf(Pointer));
    try
      GetPropList(PTypeInfo(AStyle.ClassInfo), [tkUnknown..tkDynArray], APPropList);
      for I := 0 to APropertyCount - 1 do
      begin
        if not AStyle.GetStyleValue(APPropList[I].Name, AStyleValue) then
          Continue;
        if (AStyle.Container = nil) and ((AStyle.State = csNormal) or AStyle.IsExtendedStylePropertyPublished(APPropList[I].Name)) or
          (AStyle.Container <> nil) and AStyle.Container.IsStylePropertyPublished(APPropList[I].Name, AStyle.State <> csNormal) then
        begin
          AStyleValueIndex := AStyleValueList.IndexOf(APPropList[I].Name);
          if AStyleValueIndex = -1 then
            AStyleValueList.AddObject(APPropList[I].Name, TObject(1))
          else
            AStyleValueList.Objects[AStyleValueIndex] :=
              TObject(Integer(AStyleValueList.Objects[AStyleValueIndex]) + 1);
        end;
      end;
    finally
      FreeMem(APPropList);
    end;
  end;

var
  AStyleValue: TcxContainerStyleValue;
  I: Integer;
begin
  for I := 0 to PropCount - 1 do
    FillStyleValueList(TcxContainerStyle(GetComponent(I)), AList);
  AList.Sort;

  for I := AList.Count - 1 downto 0 do
    if Integer(AList.Objects[I]) <> PropCount then
      AList.Delete(I)
    else
    begin
      TcxContainerStyle(GetComponent(0)).GetStyleValue(AList[I], AStyleValue);
      AList.Objects[I] := TObject(AStyleValue);
    end;
end;

{ TcxContainerStyleAssignedValuesElementProperty }

function TcxContainerStyleAssignedValuesElementProperty.GetName: string;
begin
  TcxContainerStyle(GetComponent(0)).GetStyleValueName(Element, Result);
end;

{$IFNDEF DELPHI6}
constructor TcxContainerStyleAssignedValuesElementProperty.Create(Parent: TPropertyEditor;
  AElement: Integer);
begin
  inherited Create(Parent, AElement);
  FElement := AElement;
end;
{$ENDIF}

  { TcxComponentEditorHelper }

constructor TcxComponentEditorHelper.Create(AComponentEditor: TComponentEditor;
  const AProductName, AProductMajorVersion, AProductMinorVersion: string);
begin
  inherited Create;
  FComponentEditor := AComponentEditor;
  FProductName := AProductName;
  FProductMajorVersion := AProductMajorVersion;
  FProductMinorVersion := AProductMinorVersion;
end;

function TcxComponentEditorHelper.GetVerb(Index: Integer): string;
begin
  Index := Index - (FComponentEditor.GetVerbCount - GetVerbCount);
  case Index of
    0: Result := '-';
    1: Result := FProductName + ' ' + Format('%s.%s', [FProductMajorVersion, FProductMinorVersion]);
    2: Result := dxCompanyName;
    3: Result := dxCompanyURL;
  end;
end;

function TcxComponentEditorHelper.GetVerbCount: Integer;
begin
  Result := 4;
end;

{ TcxComponentEditor }

constructor TcxComponentEditor.Create(AComponent: TComponent; ADesigner: IDesigner);
begin
  inherited;
  FHelper := TcxComponentEditorHelper.Create(Self, GetProductName, GetProductMajorVersion, GetProductMinorVersion);
end;

destructor TcxComponentEditor.Destroy;
begin
  FreeAndNil(FHelper);
  inherited;
end;

function TcxComponentEditor.GetVerb(Index: Integer): string;
begin
  if Index < InternalGetVerbCount then
    Result := InternalGetVerb(Index)
  else
    Result := FHelper.GetVerb(Index);
end;

function TcxComponentEditor.GetVerbCount: Integer;
begin
  Result := FHelper.GetVerbCount + InternalGetVerbCount;
end;

procedure TcxComponentEditor.ExecuteVerb(Index: Integer);
begin
  if Index < InternalGetVerbCount then
    InternalExecuteVerb(Index);
end;

function TcxComponentEditor.InternalGetVerb(AIndex: Integer): string;
begin
  Result := '';
end;

function TcxComponentEditor.GetProductMinorVersion: string;
begin
  Result := IntToStr(dxBuildNumber);
end;

function TcxComponentEditor.InternalGetVerbCount: Integer;
begin
  Result := 0;
end;

procedure TcxComponentEditor.InternalExecuteVerb(AIndex: Integer);
begin
// do nothing
end;

{ TcxDefaultEditor }

constructor TcxDefaultEditor.Create(AComponent: TComponent; ADesigner: IDesigner);
begin
  inherited;
  FHelper := TcxComponentEditorHelper.Create(Self, GetProductName, GetProductMajorVersion, GetProductMinorVersion);
end;

destructor TcxDefaultEditor.Destroy;
begin
  FreeAndNil(FHelper);
  inherited;
end;

function TcxDefaultEditor.GetVerb(Index: Integer): string;
begin
  if Index < InternalGetVerbCount then
    Result := InternalGetVerb(Index)
  else
    Result := FHelper.GetVerb(Index);
end;

function TcxDefaultEditor.GetVerbCount: Integer;
begin
  Result := FHelper.GetVerbCount + InternalGetVerbCount;
end;

function TcxDefaultEditor.InternalGetVerb(AIndex: Integer): string;
begin
  Result := '';
end;

function TcxDefaultEditor.GetProductMinorVersion: string;
begin
  Result := IntToStr(dxBuildNumber); 
end;

function TcxDefaultEditor.InternalGetVerbCount: Integer;
begin
  Result := 0;
end;

{ TcxControlPopupMenuProperty }

procedure TcxControlPopupMenuProperty.GetValues(Proc: TGetStrProc);
begin
  FProc := Proc;
  inherited GetValues(CheckComponent);
end;

procedure TcxControlPopupMenuProperty.CheckComponent(const Value: string);
var
  AComponent: TComponent;
  AIcxPopupMenu: IcxPopupMenu;
begin
  AComponent := Designer.GetComponent(Value);
  if AComponent <> nil then
  begin
    if (AComponent is TPopupMenu) or
      Supports(AComponent, IcxPopupMenu, AIcxPopupMenu) then
      FProc(Value);
  end;
end;

{ TcxLookAndFeelProperty }

procedure TcxLookAndFeelProperty.GetProperties(Proc: TGetPropProc);
begin
  FProc := Proc;
  inherited GetProperties(GetPropProc);
end;

procedure TcxLookAndFeelProperty.GetPropProc(
  {$IFNDEF DELPHI6}Prop: TPropertyEditor{$ELSE}const Prop: IProperty{$ENDIF});
var
  I: Integer;
begin
  for I := 0 to PropCount - 1 do
    if SameText(Prop.GetName, 'SkinName') and
      (not ClassSupportsSkinProc(GetComponent(0)) or (GetExtendedStylePainters.Count = 0)) then Exit;
  FProc(Prop);
end;

{ TcxLookAndFeelAssignedValuesProperty }

procedure TcxLookAndFeelAssignedValuesProperty.GetProperties(Proc: TGetPropProc);
begin
  FProc := Proc;
  inherited GetProperties(GetPropProc);
end;

procedure TcxLookAndFeelAssignedValuesProperty.GetPropProc(
  {$IFNDEF DELPHI6}Prop: TPropertyEditor{$ELSE}const Prop: IProperty{$ENDIF});
var
  I: Integer;
begin
  for I := 0 to PropCount - 1 do
    if SameText(Prop.GetName, 'lfvSkinName') and
      (not ClassSupportsSkinProc(TcxLookAndFeel(GetComponent(0)).Owner) or
      (GetExtendedStylePainters.Count = 0)) then Exit;
  FProc(Prop);
end;

{ TcxStyleProperty }

const
  sCreateNewStyleInRepositoryBegin = '<Create a new style in ';
  sCreateNewStyleInRepositoryEnd = '>';
  sCreateNewStyleInNewRepository = '<Create a new style in the new repository>';

  StylePreviewAreaWidth = 55;
  StylePreviewAreaOffset = 3;
  StyleTextOffset = 1;
  StylePreviewOffset = StyleTextOffset;
  StylePreviewBorderSize = 1;

type
  TcxStyleProperty = class(TComponentProperty{$IFDEF DELPHI6},
    ICustomPropertyDrawing, ICustomPropertyListDrawing{$ENDIF})
  private
    FStyleRepositories: TList;
    procedure GetStyleRepositoryNameProc(const S: string);
  protected
    // ICustomPropertyDrawing
  {$IFDEF DELPHI6}
    procedure PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
  {$ENDIF}
    procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);{$IFNDEF DELPHI6} override;{$ENDIF}
    // ICustomPropertyListDrawing
    procedure ListMeasureWidth(const Value: string; ACanvas: TCanvas; var AWidth: Integer);{$IFNDEF DELPHI6} override;{$ENDIF}
    procedure ListMeasureHeight(const Value: string; ACanvas: TCanvas; var AHeight: Integer);{$IFNDEF DELPHI6} override;{$ENDIF}
    procedure ListDrawValue(const Value: string; ACanvas: TCanvas;
      const ARect: TRect; ASelected: Boolean);{$IFNDEF DELPHI6} override;{$ENDIF}

    function GetStyleRepositories: TList;
  public
    function AutoFill: Boolean; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
  end;

procedure TcxStyleProperty.GetStyleRepositoryNameProc(const S: string);
begin
  FStyleRepositories.Add(Designer.GetComponent(S));