cxdesignwindows.pas

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

{********************************************************************}
{                                                                    }
{       Developer Express Visual Component Library                   }
{       ExpressCommonLibrary                                         }
{                                                                    }
{       Copyright (c) 1998-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 EXPRESSCOMMONLIBRARY 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 cxDesignWindows;

{$I cxVer.inc}

interface

uses
{$IFDEF DELPHI6}
  Types,
  DesignIntf, DesignWindows, ComponentDesigner, DesignConst,
{$ELSE}
  DsgnWnds, DsgnIntf, LibIntf, DesignConst,
{$ENDIF}
  Windows, Math, TypInfo, Classes, SysUtils, Controls, Graphics, Menus, Forms, StdCtrls, ExtCtrls,
  cxClasses;

type
{$IFNDEF DELPHI6}
  IDesigner = IFormDesigner;
{$ENDIF}

{$IFDEF DELPHI6}
  TDesignerSelectionList = IDesignerSelections;
{$ENDIF}

  TcxDesignWindow = class;

  { TcxDesignHelper }

  TcxDesignHelper = class(TObject, IUnknown, IcxDesignHelper)
  private
    FComponent: TComponent;
    FDesigner: IDesigner;
    FList: TList;
    FRefCount: Integer;
    FWindow: TcxDesignWindow;
    function GetDesigner: IDesigner;
  protected
    // IUnknown
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    procedure NotifyListeners(AList: TList);
    procedure SelectionsChanged(Sender: TObject; const ASelection: TDesignerSelectionList);
  public
    constructor Create(AComponent: TComponent); virtual;
    destructor Destroy; override;
    procedure ChangeSelection(AObject: TPersistent); overload;
    procedure GetSelection(AList: TList);
    function IsObjectSelected(AObject: TPersistent): Boolean; overload;
    procedure SelectObject(AObject: TPersistent; AClearSelection: Boolean = True;
      AActivateOwner: Boolean = True); overload;
    procedure SetSelection(AList: TList);
    procedure UnselectObject(AObject: TPersistent); overload;
    // IcxDesignHelper
    procedure AddSelectionChangedListener(AListener: TPersistent);
    function CanAddComponent(AOwner: TComponent): Boolean;
    function CanDeleteComponent(AOwner: TComponent; AComponent: TComponent): Boolean;
    procedure ChangeSelection(AOwner: TComponent; AObject: TPersistent); overload;
    function IsObjectSelected(AOwner: TComponent; AObject: TPersistent): Boolean; overload;
    procedure Modified; virtual;
    procedure RemoveSelectionChangedListener(AListener: TPersistent);
    procedure SelectObject(AOwner: TComponent; AObject: TPersistent; AClearSelection: Boolean = True;
      AActivateOwner: Boolean = True); overload;
    procedure ShowComponentDefaultEventHandler(AComponent: TComponent);
    function UniqueName(const ABaseName: string): string;
    procedure UnselectObject(AOwner: TComponent; AObject: TPersistent); overload;

    property Component: TComponent read FComponent write FComponent;
    property Designer: IDesigner read GetDesigner;
  end;

  { TcxDesignWindow }

  TcxSelectionsChanged = procedure(Sender: TObject; const ASelection: TDesignerSelectionList) of object;

  TcxDesignWindow = class(TDesignWindow)
  private
    FLockCount: Integer;
    FOnSelectionsChanged: TcxSelectionsChanged;
  protected
    procedure Activated; override;
    function UniqueName(Component: TComponent): string; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure BeginUpdate;
    procedure CancelUpdate;
    procedure EndUpdate;
    class function GetBaseRegKey{$IFDEF DELPHI6}(ADesigner: IComponentDesigner = nil){$ENDIF}: string;
    procedure GetSelectionList(AList: TList);
    procedure SelectionChanged({$IFDEF DELPHI6}const ADesigner: IDesigner;{$ENDIF}
      {$IFDEF DELPHI6}const{$ENDIF}ASelection: TDesignerSelectionList); override;
    procedure SelectionsChanged(const ASelection: TDesignerSelectionList); virtual;
    procedure SetSelectionList(AList: TList);
    procedure UpdateSelection;
    property LockCount: Integer read FLockCount;
    property OnSelectionsChanged: TcxSelectionsChanged
      read FOnSelectionsChanged write FOnSelectionsChanged;
  end;

  { TcxDesignFormEditor }

  TcxDesignFormEditor = class(TcxDesignWindow)
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    FClosing: Boolean;
  protected
    ComponentProperty: TPersistent;
    ComponentPropertyName: string;
  {$IFDEF DELPHI9}
    procedure CreateParams(var Params: TCreateParams); override;
  {$ENDIF}
    procedure CloseEditor; virtual;
    procedure InitFormEditor; virtual;
    procedure UpdateCaption; virtual;
    procedure UpdateContent; virtual;
  public
    Component: TComponent;
    ComponentClassName: string;
    function CanAddComponent: Boolean;
    function CanDeleteComponent(AComponent: TComponent): Boolean;
  {$IFDEF DELPHI6}
    procedure DesignerClosed(const ADesigner: IDesigner; AGoingDormant: Boolean); override;
  {$ELSE}
    procedure FormClosed(AForm: TCustomForm); override;
    procedure ComponentDeleted(Component: IPersistent); override;
    procedure FormModified; override;
  {$ENDIF}
    procedure DoItemsModified; virtual;
    procedure ItemDeleted(const ADesigner: IDesigner; AItem: TPersistent); {$IFNDEF DELPHI6}virtual;{$ELSE}override;{$ENDIF}
    procedure ItemsModified(const Designer: IDesigner); {$IFNDEF DELPHI6}virtual;{$ELSE}override;{$ENDIF}
    procedure SelectComponent(AComponent: TPersistent);
    procedure SelectComponents(AList: TList; ADefaultComponent: TPersistent); virtual;

    procedure ListBoxApplySelection(AListBox: TListBox; ADefaultComponent: TPersistent);
    procedure ListBoxSynchronizeSelection(AListBox: TListBox);

    property Closing: Boolean read FClosing;
  end;

  TcxDesignFormEditorClass = class of TcxDesignFormEditor;

function ShowFormEditorClass(ADesigner: IDesigner; AComponent: TComponent;
  AFormEditorClass: TcxDesignFormEditorClass): TcxDesignFormEditor; overload;
function ShowFormEditorClass(ADesigner: IDesigner; AComponent: TComponent;
  AProperty: TPersistent; const APropertyName: string;
  AFormEditorClass: TcxDesignFormEditorClass): TcxDesignFormEditor; overload;
procedure UpdateDesignFormEditors(AComponent: TComponent);

function CanAddComponent(AOwner: TComponent; const ADesigner: IDesigner = nil): Boolean;
function CanDeleteComponent(AOwner, AComponent: TComponent; const ADesigner: IDesigner = nil): Boolean;
function CanChangeComponentList(AOwner: TComponent; ADesigner: IDesigner = nil): Boolean;
function GetObjectDesigner(AObject: TPersistent): IDesigner;

function CreateDesignerSelectionList: TDesignerSelectionList;
procedure DeleteDesignerSelectionList(var ASelection: TDesignerSelectionList);

procedure ConvertSelectionToList(const ASelectionList: TDesignerSelectionList; AList: TList);

// ListBox routines

type
  TcxListBoxReindexProc = procedure(AList: TList; ANewIndex: Integer) of object;

function LockListBox(AListBox: TListBox): TNotifyEvent;
procedure UnlockListBox(AListBox: TListBox; APrevOnClick: TNotifyEvent);

procedure ListBoxSetItemIndex(AListBox: TListBox; AItemIndex: Integer);
procedure ListBoxSetSelected(AListBox: TListBox; AItemIndex: Integer;
  ASelected: Boolean);

procedure ListBoxRestoreSelection(AListBox: TListBox; var ASelection: TStringList;
  AItemIndex, ATopIndex: Integer);
procedure ListBoxSaveSelection(AListBox: TListBox; var ASelection: TStringList;
  var AItemIndex, ATopIndex: Integer);

procedure ListBoxRestorePos(AListBox: TListBox; AItemIndex, ATopIndex: Integer);
procedure ListBoxSavePos(AListBox: TListBox; var AItemIndex, ATopIndex: Integer);

function ListBoxGetFirstSelectedIndex(AListBox: TListBox): Integer;
function ListBoxGetLastSelectedIndex(AListBox: TListBox): Integer;

procedure ListBoxDeleteSelection(AListBox: TListBox; ASetFocus: Boolean);
procedure ListBoxGetSelection(AListBox: TListBox; AList: TList);
procedure ListBoxLoadCollection(AListBox: TListBox; ACollection: TCollection);
procedure ListBoxSelectByObject(AListBox: TListBox; AObject: TObject);
procedure ListBoxSyncSelection(AListBox: TListBox; AList: TList);
procedure ListBoxClearSelection(AListBox: TListBox);
procedure ListBoxSelectAll(AListBox: TListBox);

procedure ListBoxMoveItems(AListBox: TListBox; AIndex: Integer;
  var APrevDragIndex: Integer; AReindexProc: TcxListBoxReindexProc);
procedure ListBoxMoveUpItems(AListBox: TListBox; var APrevDragIndex: Integer;
  AReindexProc: TcxListBoxReindexProc);
procedure ListBoxMoveDownItems(AListBox: TListBox; var APrevDragIndex: Integer;
  AReindexProc: TcxListBoxReindexProc);

procedure ListBoxDragOver(AListBox: TListBox; Sender, Source: TObject;
  X, Y: Integer; State: TDragState; var Accept: Boolean; var APrevDragIndex: Integer);
procedure ListBoxDragDrop(AListBox: TListBox; Sender, Source: TObject;
  X, Y: Integer; var APrevDragIndex: Integer; AReindexProc: TcxListBoxReindexProc);
procedure ListBoxEndDrag(AListBox: TListBox; Sender, Target: TObject;
  X, Y: Integer; var APrevDragIndex: Integer);

// component rename routines

function CreateUniqueName(AOwnerForm, AOwnerComponent, AChildComponent: TComponent;
  const ATruncateClassName, AFieldName: string): string;

// menu routines

function CreateMenuItem(AOwner: TComponent; const ACaption: string;
  AOnClick: TNotifyEvent = nil; AEnabled: Boolean = True; ATag: Integer = -1;
  AChecked: Boolean = False): TMenuItem;

// themed IDE routines

{$IFDEF DELPHI10}  // should be DELPHI105
procedure MakeColoredControlsOpaque(ARoot: TControl);
{$ENDIF}

implementation

{$R cxDesignWindow.dfm}
{$R *.dfm}

var
  Editors: TList;

function ShowFormEditorClass(ADesigner: IDesigner; AComponent: TComponent;
  AProperty: TPersistent; const APropertyName: string;
  AFormEditorClass: TcxDesignFormEditorClass): TcxDesignFormEditor;
var
  I: Integer;
begin
  if Editors = nil then
    Editors := TList.Create;
  for I := 0 to Editors.Count - 1 do
  begin
    Result := TcxDesignFormEditor(Editors[I]);
    with Result do
      if (Designer = ADesigner) and (Component = AComponent) and
        (AProperty = ComponentProperty) and
        (CompareText(APropertyName, ComponentPropertyName) = 0) then
      begin
        Show;
        BringToFront;
        Exit;
      end;
  end;
  Result := AFormEditorClass.Create(Application);
  with Result do
  try
    Designer := ADesigner;
    Component := AComponent;
    ComponentClassName := AComponent.ClassName;
    ComponentProperty := AProperty;
    ComponentPropertyName := APropertyName;
    InitFormEditor;
    Show;
  except
    Free;
  end;
end;

function ShowFormEditorClass(ADesigner: IDesigner; AComponent: TComponent;
  AFormEditorClass: TcxDesignFormEditorClass): TcxDesignFormEditor;
begin
  Result := ShowFormEditorClass(ADesigner, AComponent, nil, '', AFormEditorClass);
end;

procedure UpdateDesignFormEditors(AComponent: TComponent);
var
  I: Integer;
  ADesignFormEditor: TcxDesignFormEditor;
begin
  if Editors = nil then
    Editors := TList.Create;
  for I := 0 to Editors.Count - 1 do
  begin
    ADesignFormEditor := TcxDesignFormEditor(Editors[I]);
    if ADesignFormEditor.Component = AComponent then
      ADesignFormEditor.UpdateContent;
  end;
end;

function CanAddComponent(AOwner: TComponent; const ADesigner: IDesigner = nil): Boolean;
begin
  Result := CanChangeComponentList(AOwner, ADesigner);
end;

function CanDeleteComponent(AOwner, AComponent: TComponent; const ADesigner: IDesigner = nil): Boolean;
begin
  Result := CanChangeComponentList(AOwner, ADesigner) and
    ((AComponent = nil) or not (csAncestor in AComponent.ComponentState));
end;

function CanChangeComponentList(AOwner: TComponent; ADesigner: IDesigner = nil): Boolean;
begin
  if ADesigner = nil then
    ADesigner := GetObjectDesigner(AOwner);
  Result := not ADesigner.IsSourceReadOnly and not (csInline in AOwner.ComponentState);
end;

function GetObjectDesigner(AObject: TPersistent): IDesigner;
begin
  Result := FindRootDesigner(AObject) as IDesigner;
end;

function CreateDesignerSelectionList: TDesignerSelectionList;
begin
{$IFDEF DELPHI6}
  Result := CreateSelectionList;
{$ELSE}
  Result := TDesignerSelectionList.Create;
{$ENDIF}
end;

procedure DeleteDesignerSelectionList(var ASelection: TDesignerSelectionList);
begin
{$IFNDEF DELPHI6}
  FreeAndNil(ASelection);
{$ELSE}
  ASelection := nil;
{$ENDIF}
end;

procedure ConvertSelectionToList(const ASelectionList: TDesignerSelectionList; AList: TList);
var
  I: Integer;
begin
  AList.Clear;
  if ASelectionList <> nil then
  begin
    AList.Capacity := ASelectionList.Count;
    for I := 0 to ASelectionList.Count - 1 do
      AList.Add(ASelectionList[I]);
  end;
end;

// ListBox Routines

function LockListBox(AListBox: TListBox): TNotifyEvent;
begin
  Result := AListBox.OnClick;
  AListBox.OnClick := nil;
end;

procedure UnlockListBox(AListBox: TListBox; APrevOnClick: TNotifyEvent);
begin
  AListBox.OnClick := APrevOnClick;
end;

procedure ListBoxSetItemIndex(AListBox: TListBox; AItemIndex: Integer);
var
  APrevOnClick: TNotifyEvent;
begin
  APrevOnClick := LockListBox(AListBox);
  try
    AListBox.ItemIndex := AItemIndex;
  finally
    UnlockListBox(AListBox, APrevOnClick);
  end;
end;

procedure ListBoxSetSelected(AListBox: TListBox; AItemIndex: Integer; 
  ASelected: Boolean);
var
  APrevOnClick: TNotifyEvent;
begin
  APrevOnClick := LockListBox(AListBox);
  try
    if AListBox.Selected[AItemIndex] <> ASelected then
      AListBox.Selected[AItemIndex] := ASelected;
  finally
    UnlockListBox(AListBox, APrevOnClick);
  end;
end;

procedure ListBoxRestoreSelection(AListBox: TListBox; var ASelection: TStringList;
  AItemIndex, ATopIndex: Integer);
var
  I: Integer;
  APrevOnClick: TNotifyEvent;
begin
  try
    APrevOnClick := LockListBox(AListBox);
    try
      with AListBox do
        for I := 0 to Items.Count - 1 do
          Selected[I] := ASelection.IndexOfObject(Items.Objects[I]) <> -1;
      if ATopIndex <> -1 then AListBox.TopIndex := ATopIndex;
      if AItemIndex <> -1 then AListBox.ItemIndex := AItemIndex;
    finally
      UnlockListBox(AListBox, APrevOnClick);
    end;
  finally
    AListBox.Items.EndUpdate;
    FreeAndNil(ASelection);
  end;
end;

procedure ListBoxSaveSelection(AListBox: TListBox; var ASelection: TStringList;
  var AItemIndex, ATopIndex: Integer);
var
  I: Integer;
begin
  ASelection := TStringList.Create;
  try
    AItemIndex := AListBox.ItemIndex;
    ATopIndex := AListBox.TopIndex;
    with AListBox do
      for I := 0 to Items.Count - 1 do
        if Selected[I] then ASelection.AddObject(Items[I], Items.Objects[I]);
    AListBox.Items.BeginUpdate;
  except
    ASelection.Free;
    ASelection := nil;
  end;
end;

procedure ListBoxRestorePos(AListBox: TListBox; AItemIndex, ATopIndex: Integer);
var
  APrevOnClick: TNotifyEvent;
begin
  APrevOnClick := LockListBox(AListBox);
  try
    if ATopIndex <> -1 then AListBox.TopIndex := ATopIndex;
    if AItemIndex <> -1 then AListBox.ItemIndex := AItemIndex;
  finally
    UnlockListBox(AListBox, APrevOnClick);
  end;
//  AListBox.Items.EndUpdate;
end;

procedure ListBoxSavePos(AListBox: TListBox; var AItemIndex, ATopIndex: Integer);
begin
  AItemIndex := AListBox.ItemIndex;
  ATopIndex := AListBox.TopIndex;
//  AListBox.Items.BeginUpdate;
end;