cxgridlevel.pas

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

{********************************************************************}
{                                                                    }
{       Developer Express Visual Component Library                   }
{       ExpressQuantumGrid                                           }
{                                                                    }
{       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 EXPRESSQUANTUMGRID 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 cxGridLevel;

{$I cxVer.inc}
{$I cxGridVer.inc}

interface

uses
  Classes, Graphics, ImgList,
  cxClasses, cxControls, cxGraphics, cxLookAndFeelPainters, cxStyles,
  cxCustomData,
  cxGridCustomView, cxGridCustomTableView;

type
  TcxGridDetailTabsPosition = (dtpNone, dtpLeft, dtpTop);

const
  cxGridLevelDefaultDetailFrameWidth = 1;
  cxGridLevelDefaultDetailTabsPosition = dtpNone;

  lsFirst = 0;
  lsTab = lsFirst;
  lsTabsBackground = lsFirst + 1;
  lsLast = lsTabsBackground;

type
  TcxGridLevel = class;

  TcxGridLevelOptionsClass = class of TcxGridLevelOptions;

  TcxGridLevelOptions = class(TPersistent)
  private
    FDetailFrameColor: TColor;
    FDetailFrameWidth: Integer;
    FDetailTabsPosition: TcxGridDetailTabsPosition;
    FLevel: TcxGridLevel;
    FTabsForEmptyDetails: Boolean;
    procedure SetDetailFrameColor(Value: TColor);
    procedure SetDetailFrameWidth(Value: Integer);
    procedure SetDetailTabsPosition(Value: TcxGridDetailTabsPosition);
    procedure SetTabsForEmptyDetails(Value: Boolean);
  protected
    procedure Changed(AHardChange: Boolean = True);
    property Level: TcxGridLevel read FLevel;
  public
    constructor Create(ALevel: TcxGridLevel); virtual;
    function GetDetailFrameColor: TColor;
  published
    property DetailFrameColor: TColor read FDetailFrameColor write SetDetailFrameColor
      default clDefault;
    property DetailFrameWidth: Integer read FDetailFrameWidth write SetDetailFrameWidth
      default cxGridLevelDefaultDetailFrameWidth;
    property DetailTabsPosition: TcxGridDetailTabsPosition read FDetailTabsPosition
      write SetDetailTabsPosition default cxGridLevelDefaultDetailTabsPosition;
    property TabsForEmptyDetails: Boolean read FTabsForEmptyDetails write SetTabsForEmptyDetails default True;  
  end;

  TcxGridLevelGetOwnTabStyleEvent = procedure(Sender: TcxGridLevel;
    AMasterRecord: TcxCustomGridRecord; var AStyle: TcxStyle) of object;
  TcxGridLevelGetTabStyleEvent = procedure(Sender, ATabLevel: TcxGridLevel;
    {$IFDEF BCB}var{$ELSE}out{$ENDIF} AStyle: TcxStyle) of object;

  TcxGridLevelStylesClass = class of TcxGridLevelStyles;

  TcxGridLevelStyles = class(TcxStyles)
  private
    FOnGetOwnTabStyle: TcxGridLevelGetOwnTabStyleEvent;
    FOnGetTabStyle: TcxGridLevelGetTabStyleEvent;
    function GetLevel: TcxGridLevel;
    function GetLookAndFeelPainter: TcxCustomLookAndFeelPainterClass;
  protected
    procedure Changed(AIndex: Integer); override;
    procedure DoGetOwnTabStyle(AMasterRecord: TcxCustomGridRecord; var AStyle: TcxStyle); virtual;
    procedure GetDefaultViewParams(Index: Integer; AData: TObject; out AParams: TcxViewParams); override;
    property LookAndFeelPainter: TcxCustomLookAndFeelPainterClass read GetLookAndFeelPainter;
  public
    property Level: TcxGridLevel read GetLevel;
    procedure GetTabDefaultParams(out AParams: TcxViewParams);
    procedure GetTabParams(ARecord: TcxCustomGridRecord; ATabLevel: TcxGridLevel;
      out AParams: TcxViewParams); virtual;
  published
    property Tab: TcxStyle index lsTab read GetValue write SetValue;
    property TabsBackground: TcxStyle index lsTabsBackground read GetValue write SetValue;
    property OnGetOwnTabStyle: TcxGridLevelGetOwnTabStyleEvent read FOnGetOwnTabStyle write FOnGetOwnTabStyle;
    property OnGetTabStyle: TcxGridLevelGetTabStyleEvent read FOnGetTabStyle write FOnGetTabStyle;
  end;

  TcxGridLevelGetGridViewEvent = procedure(Sender: TcxGridLevel; AMasterRecord: TcxCustomGridRecord;
    var AGridView: TcxCustomGridView) of object;

  TcxGridLevelChangeKind = (lcName, lcCaption, lcGridView, lcStructure, lcVisibility);

  TcxGridLevelClass = class of TcxGridLevel;

  TcxGridLevel = class(TcxComponent)
  private
    FCaption: string;
    FControl: TcxControl;  // TcxCustomGrid;
    FDataRelation: TcxCustomDataRelation;
    FGridView: TcxCustomGridView;
    FImageIndex: TImageIndex;
    FItems: TList;
    FMaxDetailHeight: Integer;
    FOptions: TcxGridLevelOptions;
    FParent: TcxGridLevel;
    FStyles: TcxGridLevelStyles;
    FVisible: Boolean;
    FVisibleItems: TList;
    FSubClassEvents: TNotifyEvent;
    FOnGetGridView: TcxGridLevelGetGridViewEvent;

    function GetActive: Boolean;
    function GetActuallyVisible: Boolean;
    function GetCanBeVisible: Boolean;
    function GetCount: Integer;
    function GetIndex: Integer;
    function GetIsLoading: Boolean;
    function GetIsMaster: Boolean;
    function GetIsRoot: Boolean;
    function GetIsTop: Boolean;
    function GetItem(Index: Integer): TcxGridLevel;
    function GetLevel: Integer;
    function GetVisibleCount: Integer;
    function GetVisibleIndex: Integer;
    function GetVisibleItem(Index: Integer): TcxGridLevel;
    procedure SetActive(Value: Boolean);
    procedure SetCaption(const Value: string);
    procedure SetGridView(Value: TcxCustomGridView);
    procedure SetImageIndex(Value: TImageIndex);
    procedure SetIndex(Value: Integer);
    procedure SetMaxDetailHeight(Value: Integer);
    procedure SetParent(Value: TcxGridLevel);
    procedure SetStyles(Value: TcxGridLevelStyles);
    procedure SetVisible(Value: Boolean);

    procedure AddItem(AItem: TcxGridLevel);
    procedure RemoveItem(AItem: TcxGridLevel);
    procedure ChangeItemIndex(AItem: TcxGridLevel; Value: Integer);
    function GetItemIndex(AItem: TcxGridLevel): Integer;
    procedure DestroyItems;
    procedure RefreshVisibleItemsList;

    procedure AddDataRelation(AItem: TcxGridLevel);
    procedure MoveDataRelation(AItem: TcxGridLevel; AIndex: Integer);
    procedure RemoveDataRelation(AItem: TcxGridLevel);
  protected
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    procedure SetChildOrder(Child: TComponent; Order: Integer); override;
    procedure SetName(const NewName: TComponentName); override;
    procedure SetParentComponent(Value: TComponent); override;

    function CreateLinkObject(ARelation: TcxCustomDataRelation;
      ARecordIndex: Integer): TcxCustomGridView; virtual;
    procedure Changed(AHardChange: Boolean = True); virtual;
    procedure CheckHeight(var Value: Integer); virtual;
    function GetDisplayCaption: string; virtual;
    function GetItemClass: TcxGridLevelClass; virtual;
    function GetOptionsClass: TcxGridLevelOptionsClass; virtual;
    function GetStylesClass: TcxGridLevelStylesClass; virtual;
    procedure ItemVisibleChanged(AItem: TcxGridLevel); virtual;
    procedure NotifyControl(AChangeKind: TcxGridLevelChangeKind);
    procedure SetupMasterRelation(AVisible, AIsPattern: Boolean);

    property IsLoading: Boolean read GetIsLoading;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetParentComponent: TComponent; override;
    function HasParent: Boolean; override;

    function Add: TcxGridLevel;
    function GetAvailableItem: TcxGridLevel;
    function HasAsChild(ALevel: TcxGridLevel): Boolean;
    function MakeVisible: TcxCustomGridView;

    property Active: Boolean read GetActive write SetActive;
    property ActuallyVisible: Boolean read GetActuallyVisible;
    property CanBeVisible: Boolean read GetCanBeVisible;
    property Control: TcxControl read FControl write FControl;
    property Count: Integer read GetCount;
    property DataRelation: TcxCustomDataRelation read FDataRelation;
    property DisplayCaption: string read GetDisplayCaption;
    property Index: Integer read GetIndex write SetIndex;
    property IsMaster: Boolean read GetIsMaster;
    property IsRoot: Boolean read GetIsRoot;
    property IsTop: Boolean read GetIsTop;
    property Items[Index: Integer]: TcxGridLevel read GetItem; default;
    property Level: Integer read GetLevel;
    property Parent: TcxGridLevel read FParent write SetParent;
    property VisibleCount: Integer read GetVisibleCount;
    property VisibleIndex: Integer read GetVisibleIndex;
    property VisibleItems[Index: Integer]: TcxGridLevel read GetVisibleItem;
  published
    property Caption: string read FCaption write SetCaption;
    property GridView: TcxCustomGridView read FGridView write SetGridView;
    property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
    property MaxDetailHeight: Integer read FMaxDetailHeight write SetMaxDetailHeight default 0;
    property Options: TcxGridLevelOptions read FOptions write FOptions;
    property Styles: TcxGridLevelStyles read FStyles write SetStyles;
    property Visible: Boolean read FVisible write SetVisible default True;
    property StylesEvents: TNotifyEvent read FSubClassEvents write FSubClassEvents;
    property OnGetGridView: TcxGridLevelGetGridViewEvent read FOnGetGridView write FOnGetGridView;
  end;

  { TcxGridLevelAccess }

  TcxGridLevelAccess = class
  public
    class procedure CheckHeight(AInstance: TcxGridLevel; var Value: Integer);
    class function CreateLinkObject(AInstance: TcxGridLevel;
      ARelation: TcxCustomDataRelation; ARecordIndex: Integer): TcxCustomGridView;
  end;

var
  cxGridTabAccelSupport: Boolean = True;

implementation

uses
  SysUtils, Menus, cxGrid, cxGridStrs;

type
  TcxCustomGridAccess = class(TcxCustomGrid);
  TcxCustomGridViewAccess = class(TcxCustomGridView);

{ TcxGridLevelOptions }

constructor TcxGridLevelOptions.Create(ALevel: TcxGridLevel);
begin
  inherited Create;
  FLevel := ALevel;
  FDetailFrameColor := clDefault;
  FDetailFrameWidth := cxGridLevelDefaultDetailFrameWidth;
  FDetailTabsPosition := cxGridLevelDefaultDetailTabsPosition;
  FTabsForEmptyDetails := True;
end;

procedure TcxGridLevelOptions.SetDetailFrameColor(Value: TColor);
begin
  if FDetailFrameColor <> Value then
  begin
    FDetailFrameColor := Value;
    Changed(False);
  end;
end;

procedure TcxGridLevelOptions.SetDetailFrameWidth(Value: Integer);
begin
  if Value < 0 then Value := 0;
  if FDetailFrameWidth <> Value then
  begin
    FDetailFrameWidth := Value;
    Changed;
  end;
end;

procedure TcxGridLevelOptions.SetDetailTabsPosition(Value: TcxGridDetailTabsPosition);
begin
  if FDetailTabsPosition <> Value then
  begin
    FDetailTabsPosition := Value;
    Changed;
  end;
end;

procedure TcxGridLevelOptions.SetTabsForEmptyDetails(Value: Boolean);
begin
  if FTabsForEmptyDetails <> Value then
  begin
    FTabsForEmptyDetails := Value;
    Changed;
  end;
end;

procedure TcxGridLevelOptions.Changed(AHardChange: Boolean = True);
begin
  FLevel.Changed(AHardChange);
end;

function TcxGridLevelOptions.GetDetailFrameColor: TColor;
begin
  Result := FDetailFrameColor;
  if Result = clDefault then
    Result := TcxCustomGrid(FLevel.Control).LookAndFeelPainter.DefaultFixedSeparatorColor;
end;

{ TcxGridLevelStyles }

function TcxGridLevelStyles.GetLevel: TcxGridLevel;
begin
  Result := TcxGridLevel(GetOwner);
end;

function TcxGridLevelStyles.GetLookAndFeelPainter: TcxCustomLookAndFeelPainterClass;
begin
  Result := TcxCustomGrid(Level.Control).LookAndFeelPainter;;
end;

procedure TcxGridLevelStyles.Changed(AIndex: Integer);
begin
  inherited;
  Level.Changed;
end;

procedure TcxGridLevelStyles.DoGetOwnTabStyle(AMasterRecord: TcxCustomGridRecord;
  var AStyle: TcxStyle);
begin
  if Assigned(FOnGetOwnTabStyle) then
    FOnGetOwnTabStyle(Level, AMasterRecord, AStyle);
end;

procedure TcxGridLevelStyles.GetDefaultViewParams(Index: Integer; AData: TObject;
  out AParams: TcxViewParams);
begin
  inherited;
  AParams.Font := TcxCustomGrid(Level.Control).Font;
  with LookAndFeelPainter, AParams do
    case Index of
      lsTab:
        begin
          Color := DefaultTabColor;
          TextColor := DefaultTabTextColor;
        end;
      lsTabsBackground:
        Color := {$IFDEF USETABCONTROL}clDefault{$ELSE}DefaultTabsBackgroundColor{$ENDIF};
    end;
end;

procedure TcxGridLevelStyles.GetTabDefaultParams(out AParams: TcxViewParams);
begin
  GetDefaultViewParams(lsTab, nil, AParams);
end;

procedure TcxGridLevelStyles.GetTabParams(ARecord: TcxCustomGridRecord;
  ATabLevel: TcxGridLevel; out AParams: TcxViewParams);
var
  AStyle: TcxStyle;
begin
  AStyle := nil;
  if Assigned(FOnGetTabStyle) then FOnGetTabStyle(Level, ATabLevel, AStyle);
  ATabLevel.Styles.DoGetOwnTabStyle(ARecord, AStyle);
  GetViewParams(lsTab, nil, AStyle, AParams);
end;

{ TcxGridLevel }

constructor TcxGridLevel.Create(AOwner: TComponent);
begin
  inherited;
  FImageIndex := -1;
  FItems := TList.Create;
  FOptions := GetOptionsClass.Create(Self);
  FStyles := GetStylesClass.Create(Self);
  FVisible := True;
  FVisibleItems := TList.Create;
end;

destructor TcxGridLevel.Destroy;
begin
  if not (FControl.IsLoading or FControl.IsDestroying) and IsDesigning then
    TcxCustomGrid(FControl).StructureNavigator.UnselectObject(Self);
  DestroyItems;
  GridView := nil;
  if FParent <> nil then
    FParent.RemoveItem(Self);
  FVisibleItems.Free;
  FItems.Free;
  FStyles.Free;
  FOptions.Free;
  inherited;
end;

function TcxGridLevel.GetActive: Boolean;
begin
  Result := TcxCustomGrid(FControl).ActiveLevel = Self;
end;

function TcxGridLevel.GetActuallyVisible: Boolean;
begin
  Result := FVisible and (not IsTop or Active) and
    ((FParent = nil) or FParent.ActuallyVisible);
end;

function TcxGridLevel.GetCanBeVisible: Boolean;
begin
  Result := FVisible and ((FParent = nil) or FParent.CanBeVisible);
end;

function TcxGridLevel.GetCount: Integer;
begin
  Result := FItems.Count;
end;

function TcxGridLevel.GetIndex: Integer;
begin
  Result := FParent.GetItemIndex(Self);
end;

function TcxGridLevel.GetIsLoading: Boolean;
begin
  Result := csLoading in ComponentState;
end;

function TcxGridLevel.GetIsMaster: Boolean;
begin
  Result := VisibleCount <> 0;
end;

function TcxGridLevel.GetIsRoot: Boolean;
begin
  Result := TcxCustomGrid(FControl).Levels = Self;
end;

function TcxGridLevel.GetIsTop: Boolean;
begin
  Result := FParent = TcxCustomGrid(FControl).Levels;
end;

function TcxGridLevel.GetItem(Index: Integer): TcxGridLevel;
begin
  Result := TcxGridLevel(FItems[Index]);
end;

function TcxGridLevel.GetLevel: Integer;
var
  AParent: TcxGridLevel;
begin
  Result := -1;
  AParent := Parent;
  while AParent <> nil do
  begin
    Inc(Result);
    AParent := AParent.Parent;
  end;
end;

function TcxGridLevel.GetVisibleCount: Integer;
begin
  Result := FVisibleItems.Count;
end;